diff --git a/darcs.cabal b/darcs.cabal
index 539b2647..3cc3e333 100644
--- a/darcs.cabal
+++ b/darcs.cabal
@@ -178,6 +178,7 @@ Library
                       Darcs.Patch.Prim.FileUUID.Commute
                       Darcs.Patch.Prim.FileUUID.Core
                       Darcs.Patch.Prim.FileUUID.Details
+                      Darcs.Patch.Prim.FileUUID.Format
                       Darcs.Patch.Prim.FileUUID.ObjectMap
                       Darcs.Patch.Prim.FileUUID.Read
                       Darcs.Patch.Prim.FileUUID.Show
@@ -188,6 +189,7 @@ Library
                       Darcs.Patch.Prim.V1.Commute
                       Darcs.Patch.Prim.V1.Core
                       Darcs.Patch.Prim.V1.Details
+                      Darcs.Patch.Prim.V1.Format
                       Darcs.Patch.Prim.V1.Mangle
                       Darcs.Patch.Prim.V1.Read
                       Darcs.Patch.Prim.V1.Show
@@ -216,6 +218,7 @@ Library
                       Darcs.Patch.V1.Apply
                       Darcs.Patch.V1.Commute
                       Darcs.Patch.V1.Core
+                      Darcs.Patch.V1.Format
                       Darcs.Patch.V1.Prim
                       Darcs.Patch.V1.Read
                       Darcs.Patch.V1.Show
@@ -354,14 +357,16 @@ Library
                       Darcs.Util.Exception
                       Darcs.Util.Exec
                       Darcs.Util.File
+                      Darcs.Util.Format
                       Darcs.Util.Global
                       Darcs.Util.Graph
                       Darcs.Util.Hash
                       Darcs.Util.HTTP
-                      Darcs.Util.Index
                       Darcs.Util.IndexedMonad
                       Darcs.Util.IsoDate
                       Darcs.Util.Lock
+                      Darcs.Util.ObjectStore
+                      Darcs.Util.ObjectStore.Utils
                       Darcs.Util.Parser
                       Darcs.Util.Path
                       Darcs.Util.Printer
@@ -375,7 +380,9 @@ Library
                       Darcs.Util.Ssh
                       Darcs.Util.StrictIdentity
                       Darcs.Util.Tree
+                      Darcs.Util.Tree.Diff
                       Darcs.Util.Tree.Hashed
+                      Darcs.Util.Tree.Index
                       Darcs.Util.Tree.Monad
                       Darcs.Util.Tree.Plain
                       Darcs.Util.URL
@@ -457,7 +464,6 @@ Library
                       zlib              >= 0.6.1.2 && < 0.8,
                       xml               >= 1.3.14 && < 1.4,
                       network-uri       >= 2.6 && < 2.8,
-                      network           >= 2.6 && < 3.3,
                       conduit           >= 1.3.0 && < 1.4,
                       http-conduit      >= 2.3 && < 2.4,
                       http-types        >= 0.12.1 && < 0.12.5,
@@ -480,6 +486,7 @@ Library
       ghc-options:    -Werror
 
     ghc-options:      -Wall -funbox-strict-fields -fwarn-tabs
+    ghc-options:      -Wredundant-constraints
 
     -- It's a deliberate choice to use NoMonoLocalBinds and tolerate this warning long-term,
     -- as otherwise we'd need 10s of extra type signatures in our code.
@@ -544,6 +551,7 @@ Executable          darcs
     ghc-options:    -Werror
 
   ghc-options:      -Wall -funbox-strict-fields -fwarn-tabs
+  ghc-options:      -Wredundant-constraints
 
   if flag(threaded)
     ghc-options:    -threaded
@@ -595,13 +603,16 @@ test-suite darcs-test
                     quickcheck-instances       >= 0.3.29.1 && < 0.4,
                     leancheck    >= 0.9 && < 1.1,
                     HUnit        >= 1.3 && < 1.7,
-                    test-framework             >= 0.8.1.1 && < 0.9,
-                    test-framework-hunit       >= 0.3.0.2 && < 0.4,
-                    test-framework-quickcheck2 >= 0.3.0.3 && < 0.4,
-                    test-framework-leancheck   >= 0.0.1 && < 0.1,
+                    tasty               >= 1.4.3 && < 1.5,
+                    tasty-hunit         >= 0.10.1 && < 0.11,
+                    tasty-quickcheck    >= 0.10.2 && < 0.11,
+                    tasty-leancheck     >= 0.0.2 && < 0.1,
+                    tagged              >= 0.8.8 && < 0.9,
                     vector,
                     zip-archive,
                     shelly,
+                    ansi-terminal,
+                    terminal-size,
 
   -- the tests shell out to a built darcs binary, so we depend on it to make
   -- sure that it's built. It's not actually required for build, just at runtime,
@@ -612,50 +623,52 @@ test-suite darcs-test
   -- include them in the tarball
   other-modules:    Darcs.Test.Email
                     Darcs.Test.HashedStorage
-                    Darcs.Test.Patch.Check
-                    Darcs.Test.Patch.Depends
-                    Darcs.Test.Patch.Examples.Set1
-                    Darcs.Test.Patch.Examples.Set2
-                    Darcs.Test.Patch.Examples.Unwind
-                    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.Check
-                    Darcs.Test.Patch.Properties.Mergeable
-                    Darcs.Test.Patch.Properties.RepoPatchV3
+                    Darcs.Test.Misc
+                    Darcs.Test.Misc.CommandLine
+                    Darcs.Test.Misc.Encoding
+                    Darcs.Test.Misc.Graph
+                    Darcs.Test.Misc.URL
+                    Darcs.Test.Patch
                     Darcs.Test.Patch.Arbitrary.Generic
+                    Darcs.Test.Patch.Arbitrary.Mergeable
                     Darcs.Test.Patch.Arbitrary.Named
                     Darcs.Test.Patch.Arbitrary.NamedPrim
                     Darcs.Test.Patch.Arbitrary.PatchTree
                     Darcs.Test.Patch.Arbitrary.PrimFileUUID
                     Darcs.Test.Patch.Arbitrary.PrimV1
-                    Darcs.Test.Patch.Arbitrary.Mergeable
                     Darcs.Test.Patch.Arbitrary.RepoPatchV1
                     Darcs.Test.Patch.Arbitrary.RepoPatchV2
                     Darcs.Test.Patch.Arbitrary.RepoPatchV3
                     Darcs.Test.Patch.Arbitrary.Sealed
                     Darcs.Test.Patch.Arbitrary.Shrink
+                    Darcs.Test.Patch.Binary
+                    Darcs.Test.Patch.ChangePref
+                    Darcs.Test.Patch.Check
+                    Darcs.Test.Patch.Depends
+                    Darcs.Test.Patch.Examples.Set1
+                    Darcs.Test.Patch.Examples.Set2
+                    Darcs.Test.Patch.Examples.Unwind
+                    Darcs.Test.Patch.FileUUIDModel
+                    Darcs.Test.Patch.Info
                     Darcs.Test.Patch.Merge.Checked
+                    Darcs.Test.Patch.Properties
+                    Darcs.Test.Patch.Properties.Check
+                    Darcs.Test.Patch.Properties.Generic
+                    Darcs.Test.Patch.Properties.Mergeable
+                    Darcs.Test.Patch.Properties.RepoPatchV3
+                    Darcs.Test.Patch.Properties.V1Set1
+                    Darcs.Test.Patch.Properties.V1Set2
                     Darcs.Test.Patch.Rebase
                     Darcs.Test.Patch.RepoModel
                     Darcs.Test.Patch.Selection
-                    Darcs.Test.Patch.Utils
-                    Darcs.Test.Patch.V1Model
-                    Darcs.Test.Patch.FileUUIDModel
                     Darcs.Test.Patch.Types.MergeableSequence
                     Darcs.Test.Patch.Types.Merged
                     Darcs.Test.Patch.Types.Pair
                     Darcs.Test.Patch.Types.Triple
                     Darcs.Test.Patch.Unwind
+                    Darcs.Test.Patch.Utils
+                    Darcs.Test.Patch.V1Model
                     Darcs.Test.Patch.WithState
-                    Darcs.Test.Patch
-                    Darcs.Test.Misc
-                    Darcs.Test.Misc.CommandLine
-                    Darcs.Test.Misc.Encoding
-                    Darcs.Test.Misc.Graph
-                    Darcs.Test.Misc.URL
                     Darcs.Test.Repository.Inventory
                     Darcs.Test.Shell
                     Darcs.Test.TestOnly.Instance
@@ -665,13 +678,16 @@ test-suite darcs-test
                     Darcs.Test.UI.Commands.Test.Commutable
                     Darcs.Test.UI.Commands.Test.IndexedApply
                     Darcs.Test.UI.Commands.Test.Simple
-                    Darcs.Test.Util.TestResult
+                    Darcs.Test.Util.ConsoleFormat
+                    Darcs.Test.Util.ConsoleReporter
                     Darcs.Test.Util.QuickCheck
+                    Darcs.Test.Util.TestResult
 
   if flag(warn-as-error)
     ghc-options:    -Werror
 
   ghc-options:      -Wall -funbox-strict-fields -fwarn-tabs
+  ghc-options:      -Wredundant-constraints
 
   if impl(ghc >= 9.4.1)
     ghc-options:    -Wno-gadt-mono-local-binds
diff --git a/harness/Darcs/Test/Email.hs b/harness/Darcs/Test/Email.hs
index cb5fe21f..f240b635 100644
--- a/harness/Darcs/Test/Email.hs
+++ b/harness/Darcs/Test/Email.hs
@@ -30,16 +30,16 @@ import Data.Char ( isPrint )
 import qualified Data.ByteString as B ( length, unpack, null, head,
                                         cons, empty, foldr, ByteString )
 import qualified Data.ByteString.Char8 as BC ( unlines )
-import Test.Framework ( Test, testGroup )
-import Test.Framework.Providers.QuickCheck2 ( testProperty )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.QuickCheck ( testProperty )
 import Test.QuickCheck.Instances.ByteString ()
 
 import Darcs.Util.Printer ( text, renderPS, packedString )
 import Darcs.UI.Email ( makeEmail, readEmail, formatHeader, prop_qp_roundtrip )
 import Safe ( tailErr )
 
-testSuite :: Test
-testSuite = testGroup "Darcs.Email"
+testSuite :: TestTree
+testSuite = testGroup "Darcs.UI.Email"
   [ emailParsing
   , emailHeaderNoLongLines
   , emailHeaderAsciiChars
@@ -49,8 +49,8 @@ testSuite = testGroup "Darcs.Email"
   ]
 
 -- | Checks that darcs can read the emails it generates
-emailParsing :: Test
-emailParsing = testProperty "Checking that email can be parsed" $ \bs ->
+emailParsing :: TestTree
+emailParsing = testProperty "email can be parsed" $ \bs ->
     BC.unlines (B.empty:bs++[B.empty,B.empty]) ==
               readEmail (renderPS
                     $ makeEmail "reponame" [] (Just (text "contents\n"))
@@ -59,40 +59,40 @@ emailParsing = testProperty "Checking that email can be parsed" $ \bs ->
 
 -- | Check that formatHeader never creates lines longer than 78 characters
 -- (excluding the carriage return and line feed)
-emailHeaderNoLongLines :: Test
+emailHeaderNoLongLines :: TestTree
 emailHeaderNoLongLines =
-    testProperty "Checking email header line length" $ \field value ->
+    testProperty "email header line length" $ \field value ->
       let cleanField = cleanFieldString field
       in not $ any (>78) $ map B.length $ bsLines $ formatHeader cleanField value
 
 -- Check that an email header does not contain non-ASCII characters
 -- formatHeader doesn't escape field names, there is no such thing as non-ascii
 -- field names afaik
-emailHeaderAsciiChars :: Test
+emailHeaderAsciiChars :: TestTree
 emailHeaderAsciiChars =
-    testProperty "Checking email for illegal characters" $ \field value ->
+    testProperty "no illegal characters" $ \field value ->
       let cleanField = cleanFieldString field
       in not (any (>127) (B.unpack (formatHeader cleanField value)))
 
 -- Check that header the second and later lines of a header start with a space
-emailHeaderLinesStart :: Test
+emailHeaderLinesStart :: TestTree
 emailHeaderLinesStart =
-    testProperty "Checking for spaces at start of folded email header lines" $ \field value ->
+    testProperty "spaces at start of folded email header lines" $ \field value ->
       let headerLines = bsLines (formatHeader cleanField value)
           cleanField  = cleanFieldString field
       in all (\l -> B.null l || B.head l == 32) (tailErr headerLines)
 
 -- Checks that there are no lines in email headers with only whitespace
-emailHeaderNoEmptyLines :: Test
+emailHeaderNoEmptyLines :: TestTree
 emailHeaderNoEmptyLines =
-    testProperty "Checking that there are no empty lines in email headers" $ \field value ->
+    testProperty "no empty lines in email headers" $ \field value ->
       let headerLines = bsLines (formatHeader cleanField value)
           cleanField  = cleanFieldString field
           in all (not . B.null) headerLines --(not . B.null . B.filter (not . (`elem` [10, 32, 9]))) headerLines
 
-emailCodecRoundtrip :: Test
+emailCodecRoundtrip :: TestTree
 emailCodecRoundtrip =
-    testProperty "Checking that quoted printable en- then decoding is id" $ prop_qp_roundtrip
+    testProperty "quoted printable en- then decoding is id" $ prop_qp_roundtrip
 
 bsLines :: B.ByteString -> [B.ByteString]
 bsLines = finalizeFold . B.foldr splitAtLines (B.empty, [])
diff --git a/harness/Darcs/Test/HashedStorage.hs b/harness/Darcs/Test/HashedStorage.hs
index 40c51767..b96cdbb7 100644
--- a/harness/Darcs/Test/HashedStorage.hs
+++ b/harness/Darcs/Test/HashedStorage.hs
@@ -22,7 +22,7 @@ import Darcs.Util.Cache ( mkRepoCache )
 import Darcs.Util.Path hiding ( setCurrentDirectory )
 import Darcs.Util.Lock ( withPermDir )
 import Darcs.Util.Tree hiding ( lookup )
-import Darcs.Util.Index
+import Darcs.Util.Tree.Index
 import Darcs.Util.Tree.Hashed
 import Darcs.Util.Hash
 import Darcs.Util.Tree.Monad hiding ( tree, createDirectory )
@@ -32,14 +32,12 @@ import System.Mem( performGC )
 
 import qualified Data.Set as S
 
-import Test.HUnit hiding ( path )
-import Test.Framework( testGroup )
-import qualified Test.Framework as TF ( Test )
+import Test.Tasty( TestTree, testGroup )
 import Test.QuickCheck
 import Test.QuickCheck.Instances.ByteString ()
 
-import Test.Framework.Providers.HUnit
-import Test.Framework.Providers.QuickCheck2
+import Test.Tasty.HUnit
+import Test.Tasty.QuickCheck
 
 ------------------------
 -- Test Data
@@ -94,18 +92,20 @@ equals_testdata t = sequence_ [
 -- Test list
 --
 
-tests :: [TF.Test]
-tests = [ testGroup "Darcs.Util.Hash" hash
-        , testGroup "Darcs.Util.Tree" tree
-        , testGroup "Darcs.Util.Index" index
-        , testGroup "Darcs.Util.Tree.Monad" monad
-        , testGroup "Hashed Storage" hashed ]
+tests :: [TestTree]
+tests =
+  [ testGroup "Darcs.Util.Hash" hash
+  , testGroup "Darcs.Util.Tree" tree
+  , testGroup "Darcs.Util.Tree.Index" index
+  , testGroup "Darcs.Util.Tree.Monad" monad
+  , testGroup "Plain and Pristine Trees" hashed
+  ]
 
 --------------------------
 -- Tests
 --
 
-hashed :: [TF.Test]
+hashed :: [TestTree]
 hashed = [ testCase "plain has all files" have_files
          , testCase "pristine has all files" have_pristine_files
          , testCase "pristine has no extras" pristine_no_extra
@@ -143,7 +143,7 @@ hashed = [ testCase "plain has all files" have_files
         t <- expand =<< readPlainTree "_darcs/plain"
         equals_testdata t
 
-index :: [TF.Test]
+index :: [TestTree]
 index = [ testCase "index versioning" check_index_versions
         , testCase "index listing" check_index
         , testCase "index content" check_index_content
@@ -183,7 +183,7 @@ index = [ testCase "index versioning" check_index_versions
                     align bound x `rem` bound == 0
               where _types = (bound, x) :: (Int, Int)
 
-tree :: [TF.Test]
+tree :: [TestTree]
 tree = [ testCase "modifyTree" check_modify
        , testCase "complex modifyTree" check_modify_complex
        , testCase "modifyTree removal" check_modify_remove
@@ -342,11 +342,11 @@ tree = [ testCase "modifyTree" check_modify
                   notStub Nothing = error "Did not exist."
                   notStub _ = True
 
-hash :: [TF.Test]
+hash :: [TestTree]
 hash = [ testProperty "decodeBase16 . encodeBase16 == Just" prop_base16 ]
     where prop_base16 x = (decodeBase16 . encodeBase16) x == Just x
 
-monad :: [TF.Test]
+monad :: [TestTree]
 monad = [ testCase "path expansion" check_virtual
         , testCase "rename" check_rename ]
     where check_virtual = virtualTreeMonad run testTree >> return ()
diff --git a/harness/Darcs/Test/Misc.hs b/harness/Darcs/Test/Misc.hs
index e96c9537..0e06c9d3 100644
--- a/harness/Darcs/Test/Misc.hs
+++ b/harness/Darcs/Test/Misc.hs
@@ -44,15 +44,15 @@ import Data.Maybe ( isJust )
 import Control.Monad.ST
 import Safe ( tailErr )
 import Test.HUnit ( assertBool, assertEqual, assertFailure )
-import Test.Framework.Providers.QuickCheck2 ( testProperty )
-import Test.Framework.Providers.HUnit ( testCase )
-import Test.Framework ( Test, testGroup )
+import Test.Tasty.QuickCheck ( testProperty )
+import Test.Tasty.HUnit ( testCase )
+import Test.Tasty ( TestTree, testGroup )
 import Test.QuickCheck
 import Test.QuickCheck.Instances.ByteString ()
 
 
-testSuite :: Test
-testSuite = testGroup ""
+testSuite :: [TestTree]
+testSuite =
  [ byteStringUtilsTestSuite
  , lcsTestSuite
  , commandLineTestSuite
@@ -66,14 +66,14 @@ testSuite = testGroup ""
 -- * Darcs.Util.ByteString
 -- ----------------------------------------------------------------------
 
-byteStringUtilsTestSuite :: Test
+byteStringUtilsTestSuite :: TestTree
 byteStringUtilsTestSuite = testGroup "Darcs.Util.ByteString"
   [ testCase "UTF-8 packing and unpacking preserves 'hello world'"
            (assertBool "" (unpackPSFromUTF8 (BC.pack "hello world") == "hello world"))
-  , testCase "Checking that hex packing and unpacking preserves 'hello world'"
+  , testCase "hex packing and unpacking preserves 'hello world'"
            (assertEqual "" (fmap BC.unpack (fromHex2PS $ fromPS2Hex $ BC.pack "hello world"))
                            (Right "hello world"))
-  , testProperty "Checking that hex conversion works" propHexConversion
+  , testProperty "hex conversion works" propHexConversion
   , testProperty "unlinesPS is left inverse of linesPS" prop_unlinesPS_linesPS_left_inverse
   , testProperty "linesPS is right inverse of unlinesPS" prop_linesPS_unlinesPS_right_inverse
   , testProperty "linesPS length property" prop_linesPS_length
@@ -133,13 +133,14 @@ prop_linesPS_unlinesPS_right_inverse x =
 -- Here are a few quick tests of the shiftBoundaries function.
 -- ----------------------------------------------------------------------
 
-lcsTestSuite :: Test
+lcsTestSuite :: TestTree
 lcsTestSuite = testGroup "LCS"
- [ testCase "lcs code" (mapM_ assertFailure showLcsTests)
+ [ testCase "known shifts" (mapM_ assertFailure showLcsTests)
  ]
 
 showLcsTests :: [String]
 showLcsTests = concatMap checkKnownShifts knownShifts
+
 checkKnownShifts :: ([Int],[Int],String,String,[Int],[Int])
                    -> [String]
 checkKnownShifts (ca, cb, sa, sb, ca', cb') = runST (
diff --git a/harness/Darcs/Test/Misc/CommandLine.hs b/harness/Darcs/Test/Misc/CommandLine.hs
index 9bf0cc71..00238091 100644
--- a/harness/Darcs/Test/Misc/CommandLine.hs
+++ b/harness/Darcs/Test/Misc/CommandLine.hs
@@ -6,8 +6,8 @@ module Darcs.Test.Misc.CommandLine
 import Darcs.Prelude
 
 import Test.HUnit ( assertEqual, assertFailure )
-import Test.Framework.Providers.HUnit ( testCase )
-import Test.Framework ( Test, testGroup )
+import Test.Tasty.HUnit ( testCase )
+import Test.Tasty ( TestTree, testGroup )
 
 import Darcs.Util.CommandLine ( parseCmd )
 
@@ -17,7 +17,7 @@ formatTable = [('s',"<insert subject here>"),
                ('d',"date")
               ]
 
-testParser :: (String, ([String], Bool)) -> Test
+testParser :: (String, ([String], Bool)) -> TestTree
 testParser (s, ok) =
   testCase ("Parse: " ++ show s) $
     case parseCmd formatTable s of
@@ -38,6 +38,6 @@ testCases = [("a b",(["a","b"], False)),
              ("\"/foo:%d\"", (["/foo:date"], False))
             ]
 
-commandLineTestSuite :: Test
+commandLineTestSuite :: TestTree
 commandLineTestSuite =
   testGroup "Darcs.Util.CommandLine" $ map testParser testCases
diff --git a/harness/Darcs/Test/Misc/Encoding.hs b/harness/Darcs/Test/Misc/Encoding.hs
index b19dbd45..ea20ade6 100644
--- a/harness/Darcs/Test/Misc/Encoding.hs
+++ b/harness/Darcs/Test/Misc/Encoding.hs
@@ -9,14 +9,14 @@ import System.IO.Unsafe
 
 import Darcs.Util.Encoding
 
-import Test.Framework ( Test, testGroup )
-import Test.Framework.Providers.QuickCheck2 ( testProperty )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.QuickCheck ( testProperty )
 import Test.QuickCheck
 
 decodeThenEncode :: B.ByteString -> B.ByteString
 decodeThenEncode = unsafePerformIO . (decode >=> encode)
 
-testSuite :: Test
+testSuite :: TestTree
 testSuite = testGroup "Darcs.Util.Encoding"
  [ testProperty "decode then encode roundtrips" propDecodeThenEncodeRoundTrip
  ]
diff --git a/harness/Darcs/Test/Misc/Graph.hs b/harness/Darcs/Test/Misc/Graph.hs
index e6113304..2dda3cf5 100644
--- a/harness/Darcs/Test/Misc/Graph.hs
+++ b/harness/Darcs/Test/Misc/Graph.hs
@@ -19,16 +19,15 @@ import Darcs.Util.Graph
   , prop_components
   )
 
-import Test.Framework
-    ( Test
-    , plusTestOptions
+import Test.Tasty
+    ( TestTree
+    , localOption
     , testGroup
-    , topt_maximum_generated_tests
     )
-import Test.Framework.Providers.LeanCheck ( testProperty )
+import Test.Tasty.LeanCheck ( LeanCheckTests(..), testProperty )
 import Test.LeanCheck
 
-testSuite :: Test
+testSuite :: TestTree
 testSuite =
   {- Unfortunately, test-framework is a bit limited in that it doesn't allow
   to scale the number of tests, just to set them to a fixed value. We opt to
@@ -37,7 +36,7 @@ testSuite =
   account for graphs with more than one component; however, the overall
   error is not big because the majority of graphs have only one component,
   e.g. for graphs of size 6 the average number of components is 1.22. -}
-  plusTestOptions (mempty { topt_maximum_generated_tests = Just 0x8000 }) $
+  localOption (LeanCheckTests 0x8000) $
   testGroup "Darcs.Util.Graph"
   [ testProperty "ltmis is equivalent to bkmis" prop_ltmis_eq_bkmis
   , testProperty
diff --git a/harness/Darcs/Test/Misc/URL.hs b/harness/Darcs/Test/Misc/URL.hs
index b0f641b5..8fed4a9e 100644
--- a/harness/Darcs/Test/Misc/URL.hs
+++ b/harness/Darcs/Test/Misc/URL.hs
@@ -4,8 +4,8 @@ module Darcs.Test.Misc.URL ( testSuite ) where
 import Darcs.Prelude
 
 import Test.HUnit ( assertEqual )
-import Test.Framework.Providers.HUnit ( testCase )
-import Test.Framework ( Test, testGroup )
+import Test.Tasty.HUnit ( testCase )
+import Test.Tasty ( TestTree, testGroup )
 
 import Darcs.Util.URL ( isValidLocalPath, isHttpUrl, isSshUrl )
 
@@ -56,11 +56,11 @@ cases =
   , ("host:/path:with/colons/",           False,  False,  True)
   ]
 
-test :: (String, Bool, Bool, Bool) -> Test
+test :: (String, Bool, Bool, Bool) -> TestTree
 test (input, local, http, ssh) = testCase input $ do
   assertEqual "isValidLocalPath" (isValidLocalPath input) local
   assertEqual "isHttpUrl" (isHttpUrl input) http
   assertEqual "isSshUrl" (isSshUrl input) ssh
 
-testSuite :: Test
+testSuite :: TestTree
 testSuite = testGroup "Darcs.Util.URL" $ map test cases
diff --git a/harness/Darcs/Test/Patch.hs b/harness/Darcs/Test/Patch.hs
index 666bf38c..83f0f754 100644
--- a/harness/Darcs/Test/Patch.hs
+++ b/harness/Darcs/Test/Patch.hs
@@ -19,7 +19,8 @@ module Darcs.Test.Patch ( testSuite ) where
 
 import Darcs.Prelude
 
-import Test.Framework ( Test, testGroup )
+import Test.Tasty ( TestTree, adjustOption, testGroup )
+import Test.Tasty.QuickCheck ( QuickCheckMaxSize(..) )
 
 import Darcs.Patch.Witnesses.Show
 import Darcs.Patch.FromPrim ( PrimOf )
@@ -40,6 +41,8 @@ import Darcs.Test.Patch.Arbitrary.RepoPatchV1 ()
 import Darcs.Test.Patch.Arbitrary.RepoPatchV2 ()
 import Darcs.Test.Patch.Arbitrary.RepoPatchV3 ()
 import Darcs.Test.Patch.Arbitrary.PrimV1 ()
+import qualified Darcs.Test.Patch.Binary as Binary ( testSuite )
+import qualified Darcs.Test.Patch.ChangePref as ChangePref ( testSuite )
 import Darcs.Test.Patch.Merge.Checked ( CheckedMerge )
 import Darcs.Test.Patch.RepoModel
 import Darcs.Test.Patch.WithState ( ShrinkModel )
@@ -63,22 +66,24 @@ general_patchTests
      , RP.RepoPatch p
      , PrimBased p, Commute (OnlyPrim p), ArbitraryPrim (OnlyPrim p)
      , ShrinkModel (ModelOf p) (PrimOf p)
-     , Show1 (ModelOf p), Show2 p
+     , Show2 p
      , RepoApply (PrimOf p)
      )
-  => [Test]
+  => [TestTree]
 general_patchTests =
      [ testGroup "Rebase patches" $ Rebase.testSuite @p
      , testGroup "Unwind" $ Unwind.testSuite @p
      ]
 
 -- | This is the big list of tests that will be run using testrunner.
-testSuite :: [Test]
+testSuite :: [TestTree]
 testSuite =
     [ primTests
     , repoPatchV1Tests
     , repoPatchV2Tests
     , repoPatchV3Tests
+    , namedPatchV1Tests
+    , namedPatchV2Tests
     , namedPatchV3Tests
     , Darcs.Test.Patch.Depends.testSuite
     , Darcs.Test.Patch.Info.testSuite
@@ -86,8 +91,12 @@ testSuite =
     ]
   where
     primTests = testGroup "Prim patches"
-      [ testGroup "V1.Prim wrapper for Prim.V1" $ qc_prim @Prim1
-      , testGroup "V2.Prim wrapper for Prim.V1" $ qc_prim @Prim2
+      [ testGroup "V1.Prim wrapper for Prim.V1" $
+          qc_prim_v1 @Prim1 ++
+          [ Binary.testSuite @Prim1, ChangePref.testSuite @Prim1 ]
+      , testGroup "V2.Prim wrapper for Prim.V1" $
+          qc_prim_v1 @Prim2 ++
+          [ Binary.testSuite @Prim2, ChangePref.testSuite @Prim2 ]
       , testGroup "Prim.FileUUID" $ qc_prim @FileUUID.Prim
       , testGroup "NamedPrim over V2.Prim" $ qc_named_prim @Prim2
       , testGroup "NamedPrim over Prim.FileUUID" $ qc_named_prim @FileUUID.Prim
@@ -99,21 +108,29 @@ testSuite =
       ]
     repoPatchV2Tests = testGroup "RepoPatchV2"
       [ testGroup "using V2.Prim wrapper for Prim.V1" $
-          unit_V2P1 ++ qc_V2 (undefined :: Prim2 wX wY) ++
+          unit_V2P1 ++ qc_V2 @Prim2 ++
           general_patchTests @(RepoPatchV2 Prim2)
       , testGroup "using Prim.FileUUID" $
-          qc_V2 (undefined :: FileUUID.Prim wX wY) ++
+          qc_V2 @FileUUID.Prim ++
           general_patchTests @(RepoPatchV2 FileUUID.Prim)
       ]
     repoPatchV3Tests = testGroup "RepoPatchV3"
       [ testGroup "using V2.Prim wrapper for Prim.V1" $
-          qc_V3 (undefined :: Prim2 wX wY) ++
+          qc_V3 @Prim2 ++
           general_patchTests @(RepoPatchV3 Prim2)
       , testGroup "using Prim.FileUUID" $
-          qc_V3 (undefined :: FileUUID.Prim wX wY) ++
+          qc_V3 @FileUUID.Prim ++
           general_patchTests @(RepoPatchV3 FileUUID.Prim)
       ]
+    namedPatchV1Tests = testGroup "Named RepoPatchV1"
+      [ adjustOption (\(QuickCheckMaxSize n) -> QuickCheckMaxSize (n `div` 2)) $
+          testGroup "using V1.Prim wrapper for Prim.V1" $ qc_Named_V1 @Prim1
+      ]
+    namedPatchV2Tests = testGroup "Named RepoPatchV2"
+      [ adjustOption (\(QuickCheckMaxSize n) -> QuickCheckMaxSize (n `div` 2)) $
+          testGroup "using V2.Prim wrapper for Prim.V1" $ qc_Named_V2 @Prim2
+      ]
     namedPatchV3Tests = testGroup "Named RepoPatchV3"
-      [ testGroup "using V2.Prim wrapper for Prim.V1" $
-          qc_Named_V3 (undefined :: Prim2 wX wY)
+      [ adjustOption (\(QuickCheckMaxSize n) -> QuickCheckMaxSize (n `div` 2)) $
+          testGroup "using V2.Prim wrapper for Prim.V1" $ qc_Named_V3 @Prim2
       ]
diff --git a/harness/Darcs/Test/Patch/Arbitrary/Generic.hs b/harness/Darcs/Test/Patch/Arbitrary/Generic.hs
index 31a29588..ee6f150e 100644
--- a/harness/Darcs/Test/Patch/Arbitrary/Generic.hs
+++ b/harness/Darcs/Test/Patch/Arbitrary/Generic.hs
@@ -1,15 +1,10 @@
 {-# LANGUAGE UndecidableInstances #-}
 module Darcs.Test.Patch.Arbitrary.Generic
   ( ArbitraryPrim(..)
-  , TestablePrim
   , PrimBased(..)
   , NullPatch(..)
   , RepoModel(..)
-  , MightBeEmptyHunk(..)
   , MightHaveDuplicate(..)
-  , nontrivialCommute
-  , nontrivialTriple
-  , nontrivialMerge
   , notDuplicatestriple
   ) where
 
@@ -17,39 +12,21 @@ import Darcs.Prelude
 
 import Data.Constraint (Dict(..))
 
-import Darcs.Test.Patch.Arbitrary.Shrink
-import Darcs.Test.Patch.Types.Pair ( Pair(..) )
-import Darcs.Test.Patch.WithState
-import Darcs.Test.Patch.RepoModel
-import Darcs.Test.Patch.V1Model
-import Darcs.Patch.Witnesses.Eq
-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 ( CleanMerge, Merge(..) )
-import Darcs.Patch.Invert ( Invert(..) )
 import Darcs.Patch.Commute ( Commute(..) )
+import Darcs.Patch.Effect ( Effect(..) )
 import Darcs.Patch.FromPrim ( PrimOf )
 import Darcs.Patch.Prim ( PrimCoalesce, PrimConstruct )
-import Darcs.Patch.Read ( ReadPatch )
-import Darcs.Patch.Show ( ShowPatchBasic )
+import Darcs.Patch.Witnesses.Eq
+import Darcs.Patch.Witnesses.Ordered
 import Darcs.Patch.Witnesses.Show
+import Darcs.Test.Patch.Arbitrary.Shrink
+import Darcs.Test.Patch.RepoModel
+import Darcs.Test.Patch.V1Model
+import Darcs.Test.Patch.WithState
 
 class NullPatch p where
   nullPatch :: p wX wY -> EqCheck wX wY
 
-class MightBeEmptyHunk p where
-  -- |V1 Prims support the value 'Hunk n [] []' that is treated specially in the
-  -- commute code and ends up breaking certain tests by behaving anomalously.
-  -- In practice they shouldn't appear in real repositories. For later,
-  -- as yet unreleased patch types, we should eliminate them completely.
-  -- An alternative to using this as a guard might be to avoid generating them.
-  isEmptyHunk :: p wX wY -> Bool
-  isEmptyHunk _ = False
-
-instance MightBeEmptyHunk (FL p)
-
 class MightHaveDuplicate p where
   -- |"duplicates" in V2 patches (RepoPatchV2) have lots of bugs
   -- that break various commute/merge properties.
@@ -60,32 +37,6 @@ instance MightHaveDuplicate p => MightHaveDuplicate (FL p) where
   hasDuplicate NilFL = False
   hasDuplicate (p :>: ps) = hasDuplicate p || hasDuplicate ps
 
-nontrivialCommute :: (Commute p, Eq2 p) => Pair p wX wY -> Bool
-nontrivialCommute (Pair (x :> y)) =
-  case commute (x :> y) of
-    Just (y' :> x') -> not (y' `unsafeCompare` y) || not (x' `unsafeCompare` x)
-    Nothing -> False
-
-nontrivialMerge :: (Eq2 p, Merge p) => (p :\/: p) wX wY -> Bool
-nontrivialMerge (x :\/: y) =
-  case merge (x :\/: y) of
-    y' :/\: x' -> not (y' `unsafeCompare` y) || not (x' `unsafeCompare` x)
-
-nontrivialTriple :: (Eq2 p, Commute p) => (p :> p :> p) wX wY -> Bool
-nontrivialTriple (a :> b :> c) =
-  case commute (a :> b) of
-    Nothing -> False
-    Just (b' :> a') ->
-      case commute (a' :> c) of
-        Nothing -> False
-        Just (c'' :> a'') ->
-          case commute (b :> c) of
-            Nothing -> False
-            Just (c' :> b'') ->
-              (not (a `unsafeCompare` a') || not (b `unsafeCompare` b')) &&
-              (not (c' `unsafeCompare` c) || not (b'' `unsafeCompare` b)) &&
-              (not (c'' `unsafeCompare` c) || not (a'' `unsafeCompare` a'))
-
 notDuplicatestriple :: MightHaveDuplicate p => (p :> p :> p) wX wY -> Bool
 notDuplicatestriple (a :> b :> c) =
   not (hasDuplicate a || hasDuplicate b || hasDuplicate c)
@@ -118,13 +69,6 @@ class ( ArbitraryState prim
         default usesV1Model :: ModelOf prim ~ V1Model => Maybe (Dict (ModelOf prim ~ V1Model))
         usesV1Model = Just Dict
 
-type TestablePrim 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
-  )
-
 -- |Given a patch type that contains mergeable patches, such as
 -- @RepoPatchV1 prim@ or @Named (RepoPatchV1 prim)@, construct the
 -- equivalent conflict-free types, e.g. @prim@ / @Named prim@ respectively.
diff --git a/harness/Darcs/Test/Patch/Arbitrary/NamedPrim.hs b/harness/Darcs/Test/Patch/Arbitrary/NamedPrim.hs
index a147d1c4..1409c1ea 100644
--- a/harness/Darcs/Test/Patch/Arbitrary/NamedPrim.hs
+++ b/harness/Darcs/Test/Patch/Arbitrary/NamedPrim.hs
@@ -39,9 +39,6 @@ instance Shrinkable prim => Shrinkable (PrimWithName n prim) where
   shrinkAtEnd (PrimWithName n p) = mapSeal (PrimWithName n) <$> shrinkAtEnd p
   shrinkAtStart (PrimWithName n p) = mapFlipped (PrimWithName n) <$> shrinkAtStart p
 
-instance MightBeEmptyHunk p => MightBeEmptyHunk (NamedPrim p) where
-  isEmptyHunk = isEmptyHunk . wnPatch
-
 instance MightHaveDuplicate (NamedPrim p)
 
 instance NullPatch p => NullPatch (NamedPrim p) where
diff --git a/harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs b/harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs
index 48a7ec99..ff2ecd54 100644
--- a/harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs
+++ b/harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs
@@ -17,6 +17,7 @@ import Darcs.Patch.Witnesses.Eq
 import Darcs.Patch.Witnesses.Unsafe
 import Darcs.Patch.Witnesses.Ordered
 import Darcs.Patch.Prim.FileUUID ()
+import Darcs.Patch.Prim.FileUUID.ObjectMap ( isBlob )
 import Darcs.Patch.Prim.FileUUID.Core ( Prim(..), Location(..), Hunk(..), UUID(..) )
 
 import Darcs.Test.Patch.FileUUIDModel
@@ -24,6 +25,7 @@ import Darcs.Test.Util.QuickCheck ( notIn, maybeOf )
 
 import qualified Data.ByteString as B
 import Data.Maybe ( fromJust, isJust )
+import qualified Data.List as L
 import qualified Data.Map as M
 
 type instance ModelOf Prim = FileUUIDModel
@@ -39,7 +41,6 @@ instance Shrinkable Prim where
   shrinkAtEnd _ = []
   shrinkAtStart _ = []
 
-instance MightBeEmptyHunk Prim
 instance MightHaveDuplicate Prim
 
 instance NullPatch Prim where
@@ -69,15 +70,15 @@ aHunk content = do
   return $ H pos old new
 
 aTextHunk :: (UUID, Object Fail) -> Gen (Prim wX wY)
-aTextHunk (uuid, (Blob text _)) =
-  do h <- aHunk (unFail text)
-     return $ Hunk uuid h
+aTextHunk (uuid, (Blob text _)) = do
+  h <- aHunk (unFail text)
+  return $ Hunk uuid h
 aTextHunk _ = error "impossible case"
 
 aManifest :: UUID -> (UUID, Object Fail) -> Gen (Prim wX wY)
-aManifest uuid (dirId, Directory dir) =
-  do filename <- aFilename `notIn` (M.keys dir)
-     return $ Manifest uuid (L dirId filename)
+aManifest uuid (dirId, Directory dir) = do
+  filename <- aFilename `notIn` (M.keys dir)
+  return $ Manifest uuid (L dirId filename)
 aManifest _ _ = error "impossible case"
 
 aDemanifest :: UUID -> Location -> Gen (Prim wX wY)
@@ -85,78 +86,83 @@ aDemanifest uuid loc = return $ Demanifest uuid loc
 
 -- | Generates any type of 'Prim' patch, except binary and setpref patches.
 aPrim :: FileUUIDModel wX -> Gen (Sealed (WithEndState FileUUIDModel (Prim wX)))
-aPrim repo
-  = do mbFile <- maybeOf repoFiles -- some file, not necessarily manifested
-       dir <- elements repoDirs -- some directory, not necessarily manifested
-       -- note, the root directory always exists and is never manifested nor demanifested
-       mbDemanifested <- maybeOf notManifested -- something not manifested
-       mbManifested <- maybeOf manifested -- something manifested
-       fresh <- anUUID `notIn` repoIds repo -- a fresh uuid
-       let whenjust m x = if isJust m then x else 0
-           whenfile = whenjust mbFile
-           whendemanifested = whenjust mbDemanifested
-           whenmanifested = whenjust mbManifested
-       patch <- frequency
-                  [ ( whenfile 12, aTextHunk $ fromJust mbFile ) -- edit an existing file
-                  , ( 2, aTextHunk (fresh, Blob (return "") Nothing) ) -- edit a new file
-                  , ( whendemanifested 2 -- manifest an existing object
-                    , aManifest (fromJust mbDemanifested) dir
-                    )
-                  , ( whenmanifested 2
-                    , uncurry aDemanifest $ fromJust mbManifested
-                    )
-                  ]
-       let repo' = unFail $ repoApply repo patch
-       return $ seal $ WithEndState patch repo'
+aPrim repo = do
+  mbFile <- maybeOf repoFiles -- some file, not necessarily manifested
+  dir <- elements repoDirs -- some directory, not necessarily manifested
+  mbDemanifested <- maybeOf notManifested -- something not manifested
+  mbManifested <- maybeOf manifested -- something manifested
+  fresh <- anUUID `notIn` repoIds repo -- a fresh uuid
+  let whenjust mo f x =
+        case mo of
+          Just o -> (f, x o)
+          Nothing -> (0, undefined)
+      whenfile = whenjust mbFile
+      whendemanifested = whenjust mbDemanifested
+      whenmanifested = whenjust mbManifested
+  patch <-
+    frequency
+      [ whenfile 12 aTextHunk -- edit a file
+      , (2, aTextHunk (fresh, emptyFile)) -- edit a new file
+      , whendemanifested 2 (flip aManifest dir)
+      , whenmanifested 2 (uncurry aDemanifest)
+      ]
+  let repo' = unFail $ repoApply repo patch
+  return $ seal $ WithEndState patch repo'
   where
-      manifested = [ (uuid, (L dirid name)) | (dirid, Directory dir) <- repoDirs
-                                          , (name, uuid) <- M.toList dir ]
-      notManifested = [ uuid | (uuid, _) <- nonRootObjects
-                           , not (uuid `elem` map fst manifested) ]
-      repoFiles = [ (uuid, Blob x y) | (uuid, Blob x y) <- repoObjects repo ]
-      repoDirs  = [ (uuid, Directory x) | (uuid, Directory x) <- repoObjects repo ]
-      nonRootObjects = filter notRoot $ repoObjects repo where
-        notRoot (uuid, _) = uuid == rootId
+    -- note, manifest does NOT mean it is reachable from the root, it just
+    -- means it has a parent (which in turn may be manifest or not)
+    manifested =
+      [ (uuid, (L dirid name))
+      | (dirid, Directory dir) <- repoDirs
+      , (name, uuid) <- M.toList dir
+      ]
+    -- note, the root directory always exists and is never manifested nor demanifested
+    notManifested =
+      [ uuid
+      | (uuid, _) <- repoObjects repo
+      , uuid /= Root
+      , uuid `notElem` map fst manifested
+      ]
+    (repoFiles, repoDirs) = L.partition (isBlob . snd) $ repoObjects repo
 
 ----------------------------------------------------------------------
 -- *** Pairs of primitive patches
 
 -- Try to generate commutable pairs of hunks
 hunkPair :: (UUID, Object Fail) -> Gen ((Prim :> Prim) wX wY)
-hunkPair (uuid, (Blob file _)) =
-  do h1@(H off1 old1 new1) <- aHunk (unFail file)
-     (delta, content') <- selectChunk h1 (unFail file)
-     H off2' old2 new2 <- aHunk content'
-     let off2 = off2' + delta
-     return (Hunk uuid (H off1 old1 new1) :> Hunk uuid (H off2 old2 new2))
+hunkPair (uuid, (Blob file _)) = do
+  h1@(H off1 old1 new1) <- aHunk (unFail file)
+  (delta, content') <- selectChunk h1 (unFail file)
+  H off2' old2 new2 <- aHunk content'
+  let off2 = off2' + delta
+  return (Hunk uuid (H off1 old1 new1) :> Hunk uuid (H off2 old2 new2))
   where
-     selectChunk (H off old new) content = elements [prefix, suffix]
-       where prefix = (0, B.take off content)
-             suffix = (off + B.length new, B.drop (off + B.length old) content)
+    selectChunk (H off old new) content = elements [prefix, suffix]
+      where
+        prefix = (0, B.take off content)
+        suffix = (off + B.length new, B.drop (off + B.length old) content)
 hunkPair _ = error "impossible case"
 
-aPrimPair :: FileUUIDModel wX
-          -> Gen (Sealed (WithEndState FileUUIDModel (Pair Prim wX)))
-aPrimPair repo
-  = do mbFile <- maybeOf repoFiles
-       frequency
-          [ ( if isJust mbFile then 1 else 0
-            , do p1 :> p2 <- hunkPair $ fromJust mbFile
-                 let repo'  = unFail $ repoApply repo  p1
-                     repo'' = unFail $ repoApply repo' p2
-                 return $ seal $ WithEndState (Pair (p1 :> p2)) repo''
-            )
-          , ( 1
-            , do
-                -- construct the underlying pair directly to avoid any
-                -- risk of indirectly calling arbitraryStatePair (which
-                -- would cause a loop).
-                Sealed (WithEndState pair repo') <- arbitraryState repo
-                return $ seal $ WithEndState (Pair pair) repo'
-            )
-          ]
+aPrimPair
+  :: FileUUIDModel wX -> Gen (Sealed (WithEndState FileUUIDModel (Pair Prim wX)))
+aPrimPair repo = do
+  mbFile <- maybeOf repoFiles
+  frequency
+    [ ( if isJust mbFile then 1 else 0
+      , do p1 :> p2 <- hunkPair $ fromJust mbFile
+           let repo' = unFail $ repoApply repo p1
+               repo'' = unFail $ repoApply repo' p2
+           return $ seal $ WithEndState (Pair (p1 :> p2)) repo'')
+    , ( 1
+        -- construct the underlying pair directly to avoid any
+        -- risk of indirectly calling arbitraryStatePair (which
+        -- would cause a loop).
+      , do Sealed (WithEndState pair repo') <- arbitraryState repo
+           return $ seal $ WithEndState (Pair pair) repo'
+      )
+    ]
   where
-      repoFiles = [ (uuid, Blob x y) | (uuid, Blob x y) <- repoObjects repo ]
+    repoFiles = [(uuid, Blob x y) | (uuid, Blob x y) <- repoObjects repo]
 
 ----------------------------------------------------------------------
 -- Arbitrary instances
diff --git a/harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs b/harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs
index adb539ab..5936c779 100644
--- a/harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs
+++ b/harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs
@@ -7,10 +7,8 @@ module Darcs.Test.Patch.Arbitrary.PrimV1
 import Prelude ()
 import Darcs.Prelude
 
-import qualified Darcs.Test.Patch.Arbitrary.Generic as T
 import Darcs.Test.Patch.Arbitrary.Generic
     ( NullPatch(..)
-    , MightBeEmptyHunk
     , MightHaveDuplicate
     , ArbitraryPrim
     )
@@ -63,12 +61,6 @@ instance NullPatch FilePatchType where
   nullPatch (Hunk _ [] []) = unsafeCoerceP IsEq -- is this safe?
   nullPatch _ = NotEq
 
-instance MightBeEmptyHunk Prim.Prim where
-  isEmptyHunk (Prim.FP _ (Hunk _ [] [])) = True
-  isEmptyHunk _ = False
-deriving instance MightBeEmptyHunk Prim1
-deriving instance MightBeEmptyHunk Prim2
-
 instance MightHaveDuplicate Prim1
 instance MightHaveDuplicate Prim2
 
@@ -129,12 +121,19 @@ aTokReplace :: Content -> Gen (String, String, String)
 aTokReplace []
   = do w <- vectorOf 1 alpha
        w' <- vectorOf 1 alpha
-       return (defaultToks, w, w')
+       s <- alpha `suchThat` (\c -> all (c <=) (w<>w'))
+       e <- alpha `suchThat` (\c -> all (<= c) (w<>w'))
+       -- note: both w and w' must contain only chars in tokchars
+       tokchars <- elements $ [defaultToks, w<>w', [s,'-',e]]
+       return (tokchars, w, w')
 aTokReplace content
   = do let fileWords = concatMap BC.words content
-       wB <- elements fileWords
+       w <- elements fileWords
        w' <- alphaBS `notIn` fileWords
-       return (defaultToks, BC.unpack wB, BC.unpack w')
+       s <- alpha `suchThat` (\c -> BC.all (c <=) (w<>w'))
+       e <- alpha `suchThat` (\c -> BC.all (<= c) (w<>w'))
+       tokchars <- elements [defaultToks, BC.unpack (w<>w'), [s,'-',e]]
+       return (tokchars, BC.unpack w, BC.unpack w')
   where
       alphaBS = do x <- alpha; return $ BC.pack [x]
 
diff --git a/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV1.hs b/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV1.hs
index 70a36aec..d3e275ea 100644
--- a/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV1.hs
+++ b/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV1.hs
@@ -45,12 +45,9 @@ import Darcs.Test.Patch.WithState
 
 type Patch = RepoPatchV1 V1.Prim
 
-instance
-  (ArbitraryPrim prim, ApplyState prim ~ RepoState (ModelOf prim))
-  => ArbitraryMergeable (RepoPatchV1 prim)
-  where
-
-    notRepoPatchV1 = Nothing
+instance (ArbitraryPrim prim, ApplyState prim ~ RepoState (ModelOf prim)) =>
+         ArbitraryMergeable (RepoPatchV1 prim) where
+  notRepoPatchV1 = Nothing
 
 instance PrimPatch prim => CheckedMerge (RepoPatchV1 prim) where
   validateMerge v =
diff --git a/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV2.hs b/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV2.hs
index 5895156e..7cabe6f1 100644
--- a/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV2.hs
+++ b/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV2.hs
@@ -26,9 +26,7 @@ instance MightHaveDuplicate (RepoPatchV2 prim) where
 
 type instance ModelOf (RepoPatchV2 prim) = ModelOf prim
 
-instance ( ArbitraryPrim prim
-         , ApplyState prim ~ RepoState (ModelOf prim)
-         ) =>
+instance (ArbitraryPrim prim, ApplyState prim ~ RepoState (ModelOf prim)) =>
          ArbitraryMergeable (RepoPatchV2 prim) where
   notRepoPatchV1 = Just (NotRepoPatchV1 (\case {}))
 
diff --git a/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV3.hs b/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV3.hs
index b41e2288..710c1abd 100644
--- a/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV3.hs
+++ b/harness/Darcs/Test/Patch/Arbitrary/RepoPatchV3.hs
@@ -24,12 +24,9 @@ instance MightHaveDuplicate (RepoPatchV3 prim) where
 
 type instance ModelOf (RepoPatchV3 prim) = ModelOf prim
 
-instance
-  (ArbitraryPrim prim, ApplyState prim ~ RepoState (ModelOf prim))
-  => ArbitraryMergeable (RepoPatchV3 prim)
-  where
-
-    notRepoPatchV1 = Just (NotRepoPatchV1 (\case {}))
+instance (ArbitraryPrim prim, ApplyState prim ~ RepoState (ModelOf prim)) =>
+         ArbitraryMergeable (RepoPatchV3 prim) where
+  notRepoPatchV1 = Just (NotRepoPatchV1 (\case {}))
 
 instance PrimPatch prim => CheckedMerge (RepoPatchV3 prim)
 
diff --git a/harness/Darcs/Test/Patch/Binary.hs b/harness/Darcs/Test/Patch/Binary.hs
new file mode 100644
index 00000000..66599562
--- /dev/null
+++ b/harness/Darcs/Test/Patch/Binary.hs
@@ -0,0 +1,58 @@
+module Darcs.Test.Patch.Binary ( testSuite ) where
+
+import Darcs.Prelude
+
+import Test.QuickCheck
+import Test.QuickCheck.Instances.ByteString ()
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.QuickCheck ( testProperty )
+
+import qualified Darcs.Patch.Prim.V1.Core as Prim
+import Darcs.Patch.RepoPatch ( Eq2, ReadPatch, FormatPatch )
+import qualified Darcs.Patch.V1.Prim as V1
+import qualified Darcs.Patch.V2.Prim as V2
+import Darcs.Patch.Witnesses.Sealed ( Sealed2(..) )
+import Darcs.Patch.Witnesses.Show ( Show2(..) )
+import Darcs.Util.Path ( AnchoredPath(..), Name, makeName )
+
+import Darcs.Test.Patch.Properties.Generic
+
+arbitraryName :: Gen Name
+arbitraryName = arbitrary `suchThatMap` toName
+  where
+    toName bs =
+      case makeName bs of
+        Left _ -> Nothing
+        Right n -> Just n
+
+arbitraryBinary :: Gen (Prim.Prim wX wY)
+arbitraryBinary = do
+  path <- fmap AnchoredPath $ listOf arbitraryName `suchThat` (not . null)
+  old <- arbitrary
+  new <- arbitrary
+  return $ Prim.FP path (Prim.Binary old new)
+
+newtype Binary p = Binary (Sealed2 p) deriving Show
+
+instance Arbitrary (Binary V1.Prim) where
+  arbitrary = Binary . Sealed2 . V1.Prim <$> arbitraryBinary
+
+instance Arbitrary (Binary V2.Prim) where
+  arbitrary = Binary . Sealed2 . V2.Prim <$> arbitraryBinary
+
+testSuite
+  :: forall p
+   . ( Arbitrary (Binary p)
+     , Eq2 p
+     , Show2 p
+     , ReadPatch p
+     , FormatPatch p
+     )
+  => TestTree
+testSuite = testGroup "Binary"
+  [ testProperty "readPatch . formatPatch == id" $
+      unBinary (formatRead :: PatchProperty p)
+  ]
+  where
+    unBinary :: (forall wA wB. p wA wB -> x) -> Binary p -> x
+    unBinary test (Binary (Sealed2 p)) = test p
diff --git a/harness/Darcs/Test/Patch/ChangePref.hs b/harness/Darcs/Test/Patch/ChangePref.hs
new file mode 100644
index 00000000..af012118
--- /dev/null
+++ b/harness/Darcs/Test/Patch/ChangePref.hs
@@ -0,0 +1,53 @@
+module Darcs.Test.Patch.ChangePref ( testSuite ) where
+
+import Darcs.Prelude
+
+import qualified Data.ByteString.Char8 as BC
+import Test.QuickCheck
+import Test.QuickCheck.Instances.ByteString ()
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.QuickCheck ( testProperty )
+
+import qualified Darcs.Patch.Prim.V1.Core as Prim
+import Darcs.Patch.RepoPatch ( Eq2, ReadPatch, FormatPatch )
+import qualified Darcs.Patch.V1.Prim as V1
+import qualified Darcs.Patch.V2.Prim as V2
+import Darcs.Patch.Witnesses.Sealed ( Sealed2(..) )
+import Darcs.Patch.Witnesses.Show ( Show2(..) )
+import Darcs.Util.ByteString ( decodeLocale )
+
+import Darcs.Test.Patch.Properties.Generic
+
+arbitraryChangePref :: Gen (Prim.Prim wX wY)
+arbitraryChangePref = do
+  preflen <- choose (3, 10)
+  pref <- vectorOf preflen $ chooseEnum ('a', 'z')
+  let value = fmap decodeLocale $ arbitrary `suchThat` (\s -> not ('\n' `BC.elem` s))
+  old <- value
+  new <- value
+  return $ Prim.ChangePref pref old new
+
+newtype Setpref p = Setpref (Sealed2 p) deriving Show
+
+instance Arbitrary (Setpref V1.Prim) where
+  arbitrary = Setpref . Sealed2 . V1.Prim <$> arbitraryChangePref
+
+instance Arbitrary (Setpref V2.Prim) where
+  arbitrary = Setpref . Sealed2 . V2.Prim <$> arbitraryChangePref
+
+testSuite
+  :: forall p
+   . ( Arbitrary (Setpref p)
+     , Eq2 p
+     , Show2 p
+     , ReadPatch p
+     , FormatPatch p
+     )
+  => TestTree
+testSuite = testGroup "ChangePref"
+  [ testProperty "readPatch . formatPatch == id" $
+      unSetpref (formatRead :: PatchProperty p)
+  ]
+  where
+    unSetpref :: (forall wA wB. p wA wB -> x) -> Setpref p -> x
+    unSetpref test (Setpref (Sealed2 p)) = test p
diff --git a/harness/Darcs/Test/Patch/Depends.hs b/harness/Darcs/Test/Patch/Depends.hs
index 12b19aa6..e1ef9ffc 100644
--- a/harness/Darcs/Test/Patch/Depends.hs
+++ b/harness/Darcs/Test/Patch/Depends.hs
@@ -19,13 +19,13 @@ import Darcs.Util.Path ( unsafeFloatPath )
 
 import Darcs.Test.TestOnly.Instance ()
 
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.HUnit (testCase)
-import Test.HUnit (assertFailure)
+import Test.HUnit ( assertFailure )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( testCase )
 
 type Patch = RepoPatchV2 V2.Prim
 
-testSuite :: Test
+testSuite :: TestTree
 testSuite = testGroup "Darcs.Patch.Depends" $
   [ test1
   ]
@@ -33,7 +33,7 @@ testSuite = testGroup "Darcs.Patch.Depends" $
 data WA
 data WB
 
-test1 :: Test
+test1 :: TestTree
 test1 = testCase "findCommonWithThem: \"them\" patch contents should not be inspected" $ do
   let
     mkPatch :: PatchInfo -> FL V2.Prim wA wB -> PatchInfoAnd Patch wA wB
diff --git a/harness/Darcs/Test/Patch/Examples/Set1.hs b/harness/Darcs/Test/Patch/Examples/Set1.hs
index 74ffaece..31ceaf27 100644
--- a/harness/Darcs/Test/Patch/Examples/Set1.hs
+++ b/harness/Darcs/Test/Patch/Examples/Set1.hs
@@ -34,7 +34,7 @@ import Data.String ( IsString(..) )
 import Darcs.Patch
      ( commute, invert, merge
      , Named, infopatch
-     , readPatch
+     , readPatchFL
      , adddir, addfile, hunk, binary, rmdir, rmfile, tokreplace )
 import Darcs.Patch.Info ( patchinfo )
 import Darcs.Patch.FromPrim ( PrimOf, FromPrim(..) )
@@ -359,9 +359,9 @@ fromRight _ = error "impossible"
 primitiveTestPatches = testPatchesAddfile ++
                          testPatchesRmfile ++
                          testPatchesHunk ++
-                         [unseal unsafeCoercePEnd.fromRight.readPatch $
+                         [unseal unsafeCoercePEnd.fromRight.readPatchFL $
                           BC.pack "move ./test/test ./hello",
-                          unseal unsafeCoercePEnd.fromRight.readPatch $
+                          unseal unsafeCoercePEnd.fromRight.readPatchFL $
                           BC.pack "move ./test ./hello"] ++
                          testPatchesBinary
 
diff --git a/harness/Darcs/Test/Patch/FileUUIDModel.hs b/harness/Darcs/Test/Patch/FileUUIDModel.hs
index d03df444..74e3d0e9 100644
--- a/harness/Darcs/Test/Patch/FileUUIDModel.hs
+++ b/harness/Darcs/Test/Patch/FileUUIDModel.hs
@@ -8,7 +8,6 @@ module Darcs.Test.Patch.FileUUIDModel
   , repoApply
   , emptyFile
   , emptyDir
-  , root, rootId
   , repoObjects, repoIds
   , aFilename, aDirname
   , aLine, aContent
@@ -81,13 +80,6 @@ emptyDir = Directory M.empty
 ----------------------------------------------------------------------
 -- * Queries
 
-rootId :: UUID
-rootId = UUID "ROOT"
-
--- | The root directory of a repository.
-root :: FileUUIDModel wX -> (UUID, Object Fail)
-root (FileUUIDModel repo) = (rootId, fromJust $ unFail $ getObject repo rootId)
-
 repoObjects :: FileUUIDModel wX -> [(UUID, Object Fail)]
 repoObjects (FileUUIDModel repo) =
     [(uuid, obj uuid) | uuid <- unFail $ listObjects repo]
@@ -171,7 +163,7 @@ aDir (dirid:dirids) fileids =
 
 
 anUUID :: Gen UUID
-anUUID = UUID . BC.pack <$> vectorOf 4 (oneof $ map return "0123456789")
+anUUID = Recorded . BC.pack <$> vectorOf 4 (oneof $ map return "0123456789")
 
 -- | @aRepo filesNo dirsNo@ produces repositories with *at most* 
 -- @filesNo@ files and @dirsNo@ directories. 
@@ -187,15 +179,15 @@ aRepo maxFiles maxDirs = do
   dirsNo <- choose (minDirs,maxDirs)
   let (dirids, ids') = splitAt dirsNo ids
       fileids = take filesNo ids'
-  objectmap <- aDir (rootId : dirids) fileids
+  objectmap <- aDir (Root : dirids) fileids
   return $ FileUUIDModel $ objectMap $ M.fromList objectmap
 
 -- | Generate small repositories.
 -- Small repositories help generating (potentially) conflicting patches.
 instance RepoModel FileUUIDModel where
   type RepoState FileUUIDModel = ObjectMap
-  aSmallRepo = do filesNo <- frequency [(3, return 1), (1, return 2)]
-                  dirsNo <- frequency [(3, return 1), (1, return 0)]
+  aSmallRepo = do filesNo <- frequency [(3, return 1), (1, return 2), (1, return 5)]
+                  dirsNo <- frequency [(3, return 1), (1, return 0), (1, return 5)]
                   aRepo filesNo dirsNo
   repoApply (FileUUIDModel state) patch = FileUUIDModel <$> applyToState patch state
   showModel = show
diff --git a/harness/Darcs/Test/Patch/Info.hs b/harness/Darcs/Test/Patch/Info.hs
index ebcc9389..a77f0e13 100644
--- a/harness/Darcs/Test/Patch/Info.hs
+++ b/harness/Darcs/Test/Patch/Info.hs
@@ -24,9 +24,11 @@ module Darcs.Test.Patch.Info ( testSuite ) where
 import Prelude hiding ( pi )
 
 import Control.Applicative ( (<|>) )
-import qualified Data.ByteString as B ( ByteString, pack )
-import qualified Data.ByteString.Char8 as BC ( pack, unpack )
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Short as BS
 import Data.List ( sort , isPrefixOf, partition )
+import Data.String ( fromString )
 import Data.Maybe ( isNothing )
 import Data.Text as T ( find, any )
 import Data.Text.Encoding ( decodeUtf8With )
@@ -36,24 +38,23 @@ import Numeric ( showHex )
 import Test.QuickCheck ( Arbitrary(arbitrary), oneof, listOf, choose, shrink
                        , Gen, suchThat, scale )
 import Test.QuickCheck.Gen ( chooseAny )
-import Test.Framework.Providers.QuickCheck2 ( testProperty )
-import Test.Framework (Test, testGroup)
+import Test.Tasty.QuickCheck ( testProperty )
+import Test.Tasty (TestTree, testGroup)
 -- import Text.Show.Pretty ( ppShow )
 
 import Darcs.Patch.Info
-    ( PatchInfo(..), rawPatchInfo, showPatchInfo, readPatchInfo
+    ( PatchInfo(..), rawPatchInfo, formatPatchInfo, readPatchInfo
     , piLog, piAuthor, piName, validLog, validAuthor
     , validLogPS, validAuthorPS, piDateString
     )
 import Darcs.Test.TestOnly.Instance ()
 import Darcs.Util.Parser ( parse )
-import Darcs.Patch.Show ( ShowPatchFor(..) )
 import Darcs.Util.ByteString
-    ( decodeLocale, packStringToUTF8, unpackPSFromUTF8, linesPS )
-import Darcs.Util.Printer ( renderPS )
+    ( decodeLocale, packStringToUTF8, unpackPSFromUTF8 )
+import Darcs.Util.Format ( toStrictByteString )
 import Darcs.Util.IsoDate (showIsoDateTime, theBeginning)
 
-testSuite :: Test
+testSuite :: TestTree
 testSuite = testGroup "Darcs.Patch.Info"
   [ metadataDecodingTest
   , metadataEncodingTest
@@ -128,21 +129,20 @@ arbitraryUTF8PatchInfo = do
 --   inverted" setting.
 arbitraryUnencodedPatchInfo :: Gen PatchInfo
 arbitraryUnencodedPatchInfo = do
-    let d = BC.pack (showIsoDateTime theBeginning)
+    let d = BS.toShort $ BC.pack (showIsoDateTime theBeginning)
     n <- arbitraryByteString `suchThat` validLogPS
     a <- arbitraryByteString `suchThat` validAuthorPS
-    l <- linesPS `fmap` scale (* 2) arbitraryByteString
+    l <- BS.split 10 `fmap` scale (* 2) arbitraryByteString
     junk <- generateJunk
     i <- arbitrary
-    return (PatchInfo d n a (l ++ [BC.pack junk]) i)
-
-arbitraryByteString :: Gen B.ByteString
-arbitraryByteString = B.pack <$> listOf arbitrary
+    return (PatchInfo d n a (l ++ [fromString junk]) i)
+  where
+    arbitraryByteString = BS.pack <$> listOf arbitrary
 
 -- | Test that anything produced by the 'patchinfo' function is valid UTF-8
-metadataEncodingTest :: Test
+metadataEncodingTest :: TestTree
 metadataEncodingTest =
-    testProperty "Testing patch metadata encoding" propMetadataEncoding
+    testProperty "patch metadata encoding" propMetadataEncoding
 
 propMetadataEncoding :: UTF8PatchInfo -> Bool
 propMetadataEncoding (UTF8PatchInfo patchInfo) =
@@ -150,12 +150,13 @@ propMetadataEncoding (UTF8PatchInfo patchInfo) =
     && encodingOK (_piName patchInfo)
     && all encodingOK (_piLog patchInfo)
   where
-    encodingOK = isNothing . T.find (=='\xfffd') . decodeUtf8With lenientDecode
+    encodingOK =
+      isNothing . T.find (=='\xfffd') . decodeUtf8With lenientDecode . BS.fromShort
 
 -- | Test that metadata in patches are decoded as UTF-8 or locale depending on
 -- whether they're valid UTF-8.
-metadataDecodingTest :: Test
-metadataDecodingTest = testProperty "Testing patch metadata decoding" propMetadataDecoding
+metadataDecodingTest :: TestTree
+metadataDecodingTest = testProperty "patch metadata decoding" propMetadataDecoding
 
 propMetadataDecoding :: UTF8OrNotPatchInfo -> Bool
 propMetadataDecoding (UTF8OrNotPatchInfo patchInfo) =
@@ -164,13 +165,14 @@ propMetadataDecoding (UTF8OrNotPatchInfo patchInfo) =
     && map utf8OrLocale (_piLog patchInfo) `superset` piLog patchInfo
   where
     utf8OrLocale bs =
-      if isValidUTF8 bs then unpackPSFromUTF8 bs else decodeLocale bs
-
-isValidUTF8 :: B.ByteString -> Bool
-isValidUTF8 = not . T.any (=='\xfffd') . decodeUtf8With lenientDecode
-
-packUnpackTest :: Test
-packUnpackTest = testProperty "Testing UTF-8 packing and unpacking" $
+      if isValidUTF8 bs
+        then unpackPSFromUTF8 (BS.fromShort bs)
+        else decodeLocale (BS.fromShort bs)
+    isValidUTF8 =
+      not . T.any (=='\xfffd') . decodeUtf8With lenientDecode . BS.fromShort
+
+packUnpackTest :: TestTree
+packUnpackTest = testProperty "UTF-8 packing and unpacking" $
     \uString -> asString uString == (unpackPSFromUTF8 . packStringToUTF8) (asString uString)
 
 superset :: Ord a => [a] -> [a] -> Bool
@@ -188,14 +190,14 @@ withUTF8OrNotPatchInfo :: (PatchInfo -> a) -> UTF8OrNotPatchInfo -> a
 withUTF8OrNotPatchInfo f mpi = case mpi of
                                  UTF8OrNotPatchInfo pinf -> f pinf
 
-parseUnparseTest :: Test
-parseUnparseTest = testProperty "parse . show == id" propParseUnparse
+parseUnparseTest :: TestTree
+parseUnparseTest = testProperty "parse . format == id" propParseUnparse
 
 parsePatchInfo :: B.ByteString -> Either String PatchInfo
 parsePatchInfo = fmap fst . parse readPatchInfo
 
 unparsePatchInfo :: PatchInfo -> B.ByteString
-unparsePatchInfo = renderPS . showPatchInfo ForStorage
+unparsePatchInfo = toStrictByteString . formatPatchInfo
 
 -- Once generated, we assume that shrinking will preserve UTF8ness etc,
 -- so we reuse this function for all the various Arbitrary instances
@@ -215,7 +217,8 @@ shrinkPatchInfo pi =
     -- We need to be careful to preserve the junk lines to prevent creating
     -- two identical PatchInfos from different ones, which would break darcs' invariants
     -- and cause a genuine failure to be shrunk into a spurious one.
-    (junkLines, logLines) = partition (isPrefixOf "Ignore-this:") . map BC.unpack . _piLog $ pi
+    (junkLines, logLines) =
+      partition (isPrefixOf "Ignore-this:") . map (BC.unpack . BS.fromShort) . _piLog $ pi
 
 instance Arbitrary PatchInfo where
     arbitrary = arbitraryUnencodedPatchInfo
diff --git a/harness/Darcs/Test/Patch/Properties.hs b/harness/Darcs/Test/Patch/Properties.hs
index 23c022dd..6e1841f5 100644
--- a/harness/Darcs/Test/Patch/Properties.hs
+++ b/harness/Darcs/Test/Patch/Properties.hs
@@ -25,8 +25,11 @@ module Darcs.Test.Patch.Properties
   , qc_V1P1
   , qc_V2
   , qc_V3
+  , qc_Named_V1
+  , qc_Named_V2
   , qc_Named_V3
   , qc_prim
+  , qc_prim_v1
   , qc_named_prim
   ) where
 
@@ -34,9 +37,9 @@ import Darcs.Prelude
 
 import Data.Constraint ( Dict(..) )
 import Data.Maybe ( fromMaybe )
-import Test.Framework ( Test )
-import Test.Framework.Providers.QuickCheck2 ( testProperty )
-import Test.QuickCheck( Arbitrary(..) )
+import Test.QuickCheck ( Arbitrary(..) )
+import Test.Tasty ( TestTree, adjustOption )
+import Test.Tasty.QuickCheck ( QuickCheckMaxSize(..), testProperty )
 
 import Darcs.Test.Util.TestResult ( TestResult, maybeFailed )
 import Darcs.Test.Patch.Utils
@@ -52,10 +55,10 @@ import Darcs.Test.Patch.Utils
 import Darcs.Patch.Witnesses.Maybe
 import Darcs.Patch.Witnesses.Ordered
 import Darcs.Patch.Witnesses.Sealed
-import Darcs.Patch.Witnesses.Eq ( Eq2, unsafeCompare )
+import Darcs.Patch.Witnesses.Eq ( Eq2 )
 import Darcs.Patch.Witnesses.Show
 import Darcs.Patch.FromPrim ( PrimOf, FromPrim(..) )
-import Darcs.Patch.Prim ( PrimPatch, coalesce )
+import Darcs.Patch.Prim ( PrimCoalesce, PrimPatch, coalesce )
 import qualified Darcs.Patch.V1.Prim as V1 ( Prim )
 import qualified Darcs.Patch.V2.Prim as V2 ( Prim )
 import Darcs.Patch.Prim.Named ( NamedPrim )
@@ -65,8 +68,8 @@ import Darcs.Patch.V3 ( RepoPatchV3 )
 import Darcs.Patch.Commute ( Commute(..) )
 import Darcs.Patch.Invert ( Invert )
 import Darcs.Patch.Show ( ShowPatchBasic )
-import Darcs.Patch.Apply( ApplyState )
-import Darcs.Patch.Merge ( Merge )
+import Darcs.Patch.Apply( ApplyState, ObjectIdOfPatch )
+import Darcs.Patch.Merge ( CleanMerge, Merge )
 import Darcs.Patch.Named ( Named )
 import qualified Darcs.Patch.RepoPatch as RP
 
@@ -115,7 +118,14 @@ instance PrimPatch prim => RepoApply (RepoPatchV1 prim)
 instance PrimPatch prim => RepoApply (RepoPatchV2 prim)
 instance PrimPatch prim => RepoApply (RepoPatchV3 prim)
 
-unit_V1P1:: [Test]
+
+onFL :: (forall wA wB. p wA wB -> TestResult) -> FL p wX wY -> TestResult
+onFL prop = mconcat . mapFL prop
+
+onRL :: (forall wA wB. p wA wB -> TestResult) -> RL p wX wY -> TestResult
+onRL prop = mconcat . mapRL prop
+
+unit_V1P1:: [TestTree]
 unit_V1P1 =
   [ testCases "known commutes" Prop1.checkCommute Ex1.knownCommutes
   , testCases "known non-commutes" Prop1.checkCantCommute Ex1.knownCantCommutes
@@ -127,13 +137,13 @@ unit_V1P1 =
   , 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 patch IO functions" (onFL PropG.formatRead) Ex1.primitiveTestPatches
+  , testCases "IO functions (test patches)" (onFL PropG.formatRead) Ex1.testPatches
+  , testCases "IO functions (named test patches)" PropG.formatRead Ex1.testPatchesNamed
   , testCases "primitive commute/recommute" (PropG.recommute commute) Ex1.primitiveCommutePairs
   ]
 
-unit_V2P1 :: [Test]
+unit_V2P1 :: [TestTree]
 unit_V2P1 =
   [ testCases "coalesce commute" (PropG.coalesceCommute (fmap maybeToFL . coalesce)) Ex2.primPermutables
   , testCases "prim recommute" (PropG.recommute commute . Pair) Ex2.commutables
@@ -142,8 +152,8 @@ unit_V2P1 =
   , 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
+  , sealedCases "read and show work on Prim" PropG.formatRead Ex2.primPatches
+  , sealedCases "read and show work on RepoPatchV2" PropG.formatRead 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
@@ -158,7 +168,7 @@ unit_V2P1 =
   where
     fromPrim2 :: PropM.FromPrimT RepoPatchV2 Prim2
     fromPrim2 = fromAnonymousPrim
-    sealedCases :: String -> (forall wX wY. p wX wY -> TestResult) -> [Sealed2 p] -> Test
+    sealedCases :: String -> (forall wX wY. p wX wY -> TestResult) -> [Sealed2 p] -> TestTree
     sealedCases name prop = testCases name (unseal2 prop)
 
 arbitraryThing :: TestGenerator thing (Sealed2 thing)
@@ -167,14 +177,38 @@ arbitraryThing = TestGenerator (\f p -> Just (unseal2 f p))
 arbitraryWSThing :: TestGenerator thing (Sealed2 (WithState thing))
 arbitraryWSThing = TestGenerator (\f wsp -> Just (unseal2 (f . wsPatch) wsp))
 
+type TestablePrim prim =
+  ( ApplyState prim ~ RepoState (ModelOf prim)
+  , ArbitraryPrim prim
+  , CleanMerge prim
+  , Commute prim
+  , Eq2 prim
+  , Invert prim
+  , RepoModel (ModelOf prim)
+  , RP.Apply prim
+  , RP.ReadPatch prim
+  , RP.FormatPatch prim
+  , Show1 (ModelOf prim)
+  , Show2 prim
+  , ShowPatchBasic prim
+  )
+
+type TestablePrimBase prim =
+  ( ApplyState prim ~ RepoState (ModelOf prim)
+  , ArbitraryPrim prim
+  , PrimPatch prim
+  , PropagateShrink prim prim
+  , RepoApply prim
+  , Show1 (ModelOf prim)
+  , ShrinkModel (ModelOf prim) prim
+  )
+
 qc_prim :: forall prim.
            ( TestablePrim prim
-           , Show1 (ModelOf prim)
-           , MightBeEmptyHunk prim
            , MightHaveDuplicate prim
            , ArbitraryWS prim
            , RepoApply prim
-           ) => [Test]
+           ) => [TestTree]
 qc_prim =
   [testProperty "prim pair coverage" (unseal2 (PropG.propPrimPairCoverage @prim . wsPatch))] ++
   -- The following fails because of setpref patches:
@@ -198,19 +232,16 @@ qc_prim =
   , pair_repo_properties    @prim      "arbitrary"    arbitraryThing
   , pair_repo_properties    @(FL prim) "arbitrary FL" arbitraryThing
   , triple_properties       @prim      "arbitrary"    arbitraryWSThing
-  , [ testProperty "readPatch/showPatch"
-      (unseal2 $ (PropG.showRead . wsPatch) :: Sealed2 (WithState prim) -> TestResult)
-    , testProperty "readPatch/showPatch (FL)"
-      (unseal2 $ (PropG.showRead . wsPatch) :: Sealed2 (WithState (FL prim)) -> TestResult)
+  , triple_properties       @(FL prim) "arbitrary FL" arbitraryWSThing
+  , [ testProperty "readPatch . formatPatch == id"
+      (unseal2 $ (PropG.formatRead . wsPatch) :: Sealed2 (WithState prim) -> TestResult)
     ]
   ]
 
 qc_named_prim :: forall prim.
                  ( TestablePrim prim
                  , PrimPatch prim
-                 , Show1 (ModelOf (NamedPrim prim))
-                 , MightBeEmptyHunk prim
-                 ) => [Test]
+                 ) => [TestTree]
 qc_named_prim =
   qc_prim @(NamedPrim prim) ++
   [ testProperty
@@ -218,8 +249,26 @@ qc_named_prim =
       (unseal2 $ (PropG.inverseDoesntCommute . wsPatch) :: Sealed2 (WithState (NamedPrim prim)) -> TestResult)
   ]
 
+qc_prim_v1
+  :: forall prim
+   . ( TestablePrim prim
+     , MightHaveDuplicate prim
+     , ArbitraryWS prim
+     , RepoApply prim
+     , Eq (ObjectIdOfPatch prim)
+     , RP.IsHunk prim
+     , PrimCoalesce prim
+     )
+  => [TestTree]
+qc_prim_v1 =
+  qc_prim @prim ++
+  [ testProperty
+      "prims do not coalesce and commute"
+      (unseal2 $ (PropG.notCoalesceAndCommute . wsPatch)
+        :: Sealed2 (WithState (Pair prim)) -> TestResult)
+  ]
 
-qc_V1P1 :: [Test]
+qc_V1P1 :: [TestTree]
 qc_V1P1 =
   mergeablePatchProperties @(RepoPatchV1 V1.Prim) ++
   [ testProperty "commuting by patch and its inverse is ok" (Prop2.propCommuteInverse . mapSeal2 (getPair . wsPatch))
@@ -241,17 +290,8 @@ qc_V1P1 =
   , testProperty "merges can be swapped" Prop2.propMergeIsSwapable
   ]
 
-qc_V2 :: forall prim wXx wYy.
-         ( PrimPatch prim
-         , Show1 (ModelOf prim)
-         , ShrinkModel (ModelOf prim) prim
-         , PropagateShrink prim prim
-         , ArbitraryPrim prim
-         , RepoState (ModelOf prim) ~ ApplyState prim
-         , RepoApply prim
-         )
-      => prim wXx wYy -> [Test]
-qc_V2 _ =
+qc_V2 :: forall prim . TestablePrimBase prim => [TestTree]
+qc_V2 =
   [ testProperty "with quickcheck that patches are consistent"
     (withSingle consistent)
   ]
@@ -268,18 +308,8 @@ qc_V2 _ =
     consistent :: RepoPatchV2 prim wX wY -> TestResult
     consistent = maybeFailed . isConsistent
 
-qc_V3 :: forall prim wXx wYy.
-         ( PrimPatch prim
-         , Show1 (ModelOf prim)
-         , ShrinkModel (ModelOf prim) prim
-         , PropagateShrink prim prim
-         , ArbitraryPrim prim
-         , RepoState (ModelOf prim) ~ ApplyState prim
-         , RepoApply prim
-         )
-      => prim wXx wYy
-      -> [Test]
-qc_V3 _ =
+qc_V3 :: forall prim . TestablePrimBase prim => [TestTree]
+qc_V3 =
   [ testProperty "repo invariants"
     (withSequence (PropR3.prop_repoInvariants :: SequenceProperty (RepoPatchV3 prim)))
   ]
@@ -292,19 +322,14 @@ instance (ArbitraryPrim prim, ApplyState prim ~ RepoState (ModelOf prim)) =>
 
 instance MightHaveDuplicate p => MightHaveDuplicate (Named p)
 
-qc_Named_V3
-  :: forall prim wX wY
-   . ( PrimPatch prim
-     , Show1 (ModelOf prim)
-     , ShrinkModel (ModelOf prim) prim
-     , PropagateShrink prim prim
-     , ArbitraryPrim prim
-     , RepoState (ModelOf prim) ~ ApplyState prim
-     , RepoApply prim
-     )
-  => prim wX wY
-  -> [Test]
-qc_Named_V3 _ =
+qc_Named_V1 :: forall prim . TestablePrimBase prim => [TestTree]
+qc_Named_V1 = serializePatchProperties @(Named (RepoPatchV1 prim))
+
+qc_Named_V2 :: forall prim . TestablePrimBase prim => [TestTree]
+qc_Named_V2 = serializePatchProperties @(Named (RepoPatchV2 prim))
+
+qc_Named_V3 :: forall prim . TestablePrimBase prim => [TestTree]
+qc_Named_V3 =
   mergeablePatchProperties @(Named (RepoPatchV3 prim)) ++
   difficultPatchProperties @(Named (RepoPatchV3 prim))
 
@@ -316,8 +341,8 @@ type MergeablePatch p =
   , CheckedMerge p
   , PrimPatch (PrimOf p)
   , RP.Conflict p
-  , RP.PatchListFormat p
   , RP.ReadPatch p
+  , RP.FormatPatch p
   , Show2 p
   , ShowPatchBasic p
   )
@@ -326,22 +351,36 @@ mergeablePatchProperties
   :: forall p
    . ( ArbitraryMergeable p
      , MergeablePatch p
-     , Show1 (ModelOf p)
      , ShrinkModel (ModelOf p) (PrimOf p)
      , PrimBased p
      , RepoApply p
      , RepoApply (PrimOf p)
      )
-  => [Test]
+  => [TestTree]
 mergeablePatchProperties =
-  [ testProperty "readPatch/showPatch"
-      (withSingle (PropG.showRead :: PatchProperty p))
-  , testProperty "readPatch/showPatch (RL)"
-      (withSequence (PropG.showRead :: SequenceProperty p))
+  serializePatchProperties @p ++
+  [ testProperty "readPatch . showPatch == id(RL)"
+      (withSequence ((onRL PropG.formatRead) :: SequenceProperty p))
   , testProperty "resolutions don't conflict"
       (withSequence (PropM.propResolutionsDontConflict :: SequenceProperty p))
   ]
 
+serializePatchProperties
+  :: forall p
+   . ( MergeablePatch p
+     , PrimBased p
+     , RepoApply p
+     , ShrinkModel (ModelOf p) (PrimOf p)
+     , RepoState (ModelOf p) ~ ApplyState p
+     , RepoModel (ModelOf p)
+     , RepoApply (PrimOf p)
+     )
+  => [TestTree]
+serializePatchProperties =
+  [ testProperty "readPatch . formatPatch == id"
+      (withSingle (PropG.formatRead :: PatchProperty 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).
 difficultPatchProperties
@@ -350,31 +389,22 @@ difficultPatchProperties
      , MergeablePatch p
      , ShrinkModel (ModelOf p) (PrimOf p)
      , MightHaveDuplicate p
-     , Show1 (ModelOf p)
      , PrimBased p
      , RepoApply p
      , RepoApply (PrimOf p)
      )
-  => [Test]
+  => [TestTree]
 difficultPatchProperties =
-  [ testProperty "reorderings are consistent"
+  [ adjustOption (\(QuickCheckMaxSize n) -> QuickCheckMaxSize (n `div` 3)) $
+    testProperty "reorderings are consistent"
       (PropM.propConsistentReorderings @p)
   , testProperty "recommute"
       (withPair (PropG.recommute com))
-  , testConditional "nontrivial recommute"
-      (fromMaybe False . withPair nontrivialCommute)
-      (withPair (PropG.recommute com))
   , testConditional "permutivity"
       (fromMaybe False . withTriple notDuplicatestriple)
       (withTriple (PropG.permutivity com))
-  , testConditional "nontrivial permutivity"
-      (fromMaybe False . withTriple (\t -> nontrivialTriple t && notDuplicatestriple t))
-      (withTriple (PropG.permutivity com))
   , testProperty "merge either way"
       (withFork (PropG.mergeEitherWay :: 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"
@@ -392,15 +422,12 @@ pair_properties :: forall p gen
 pair_properties genname gen =
   properties gen "commute" genname
   [ ("recommute"              , TestCondition (const True)     , TestCheck (PropG.recommute commute)           )
-  , ("nontrivial recommute"   , TestCondition nontrivialCommute, TestCheck (PropG.recommute commute)           )
   , ("inverses commute"       , TestCondition (const True)     , TestCheck (PropG.commuteInverses commute)     )
-  , ("nontrivial inverses"    , TestCondition nontrivialCommute, TestCheck (PropG.commuteInverses commute)     )
   , ("inverse composition"    , TestCondition (const True)     , TestCheck PropG.inverseComposition            )
   ]
 
 coalesce_properties :: forall p gen
                      . ( Show gen, Arbitrary gen, TestablePrim p
-                       , MightBeEmptyHunk p
                        )
                     => PropList (Triple p) gen
 coalesce_properties genname gen =
@@ -421,7 +448,6 @@ prim_commute_properties :: forall p gen
 prim_commute_properties genname gen =
   properties gen "commute" genname
   [ ("square commute law", TestCondition (const True)     , TestCheck (PropG.squareCommuteLaw commute))
-  , ("nontrivial square commute law", TestCondition nontrivialCommute, TestCheck (PropG.squareCommuteLaw commute))
   ]
 
 patch_properties :: forall p gen .
@@ -461,7 +487,6 @@ merge_properties genname gen =
   properties gen "merge" genname
   [ ("merge either way"           , TestCondition (const True)   , TestCheck PropG.mergeEitherWay      )
   , ("merge either way valid"     , TestCondition (const True)   , TestCheck PropG.mergeEitherWayValid )
-  , ("nontrivial merge either way", TestCondition nontrivialMerge, TestCheck PropG.mergeEitherWay      )
   , ("merge commute"              , TestCondition (const True)   , TestCheck PropG.mergeCommute        )
   ]
 
@@ -476,9 +501,6 @@ triple_properties genname gen =
   [ ( "permutivity"
     , TestCondition (notDuplicatestriple . getTriple)
     , TestCheck (PropG.permutivity commute . getTriple) )
-  , ( "nontrivial permutivity"
-    , TestCondition (\(Triple t) -> nontrivialTriple t && notDuplicatestriple t)
-    , TestCheck (PropG.permutivity commute . getTriple) )
   ]
 
 pair_repo_properties
@@ -486,8 +508,8 @@ pair_repo_properties
      ( Show gen
      , Arbitrary gen
      , Commute p
+     , Eq2 p
      , ShowPatchBasic p
-     , MightBeEmptyHunk p
      , RepoModel (ModelOf p)
      , RepoState (ModelOf p) ~ ApplyState p
      , RepoApply p
diff --git a/harness/Darcs/Test/Patch/Properties/Generic.hs b/harness/Darcs/Test/Patch/Properties/Generic.hs
index 3d7b9081..d7091cef 100644
--- a/harness/Darcs/Test/Patch/Properties/Generic.hs
+++ b/harness/Darcs/Test/Patch/Properties/Generic.hs
@@ -15,6 +15,7 @@
 --  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 --  Boston, MA 02110-1301, USA.
 
+{-# LANGUAGE ViewPatterns #-}
 module Darcs.Test.Patch.Properties.Generic
     ( invertInvolution
     , inverseComposition
@@ -26,13 +27,14 @@ module Darcs.Test.Patch.Properties.Generic
     , permutivity
     , squareCommuteLaw
     , mergeEitherWay
-    , showRead
+    , formatRead
     , mergeEitherWayValid
     , mergeCommute
     , mergeConsistent
     , mergeArgumentsConsistent
     , coalesceEffectPreserving
     , coalesceCommute
+    , notCoalesceAndCommute
     , PatchProperty
     , MergeProperty
     , SequenceProperty
@@ -57,30 +59,29 @@ import Darcs.Test.Util.TestResult
     , maybeFailed
     , rejected
     , succeeded
+    , classify
     )
-import Darcs.Test.Patch.WithState ( WithState(..) )
-import Darcs.Test.Patch.Arbitrary.Generic
-    ( MightBeEmptyHunk(..)
-    , MightHaveDuplicate(..)
-    , TestablePrim
-    )
+import Darcs.Test.Patch.Arbitrary.Generic ( MightHaveDuplicate(..) )
+import Darcs.Test.Patch.Properties.Check ( Check, checkAPatch )
 import Darcs.Test.Patch.Types.Pair ( Pair(..) )
-import Darcs.Test.Patch.Properties.Check ( checkAPatch, Check )
+import Darcs.Test.Patch.WithState ( WithState(..) )
 
 import Control.Monad ( msum )
 
 import Darcs.Patch.Witnesses.Show ( Show2(..), show2 )
 import Darcs.Patch.Read ( ReadPatch )
-import Darcs.Patch.Show
-    ( ShowPatchBasic, displayPatch, showPatch, ShowPatchFor(ForStorage) )
+import Darcs.Patch.Show ( ShowPatchBasic, showPatch )
 import Darcs.Patch ()
-import Darcs.Patch.Apply ( ApplyState )
+import Darcs.Patch.Apply ( ApplyState, ObjectIdOfPatch )
 import Darcs.Patch.Commute ( Commute, commute, commuteFL )
 import Darcs.Patch.CommuteFn ( CommuteFn )
+import Darcs.Patch.Format ( FormatPatch(..) )
+import Darcs.Patch.FileHunk
 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.Prim (PrimCoalesce(..) )
 import Darcs.Patch.Witnesses.Eq ( Eq2(..), EqCheck(..) )
 import Darcs.Patch.Witnesses.Ordered
     ( (:/\:)(..)
@@ -91,7 +92,17 @@ import Darcs.Patch.Witnesses.Ordered
     , mapFL
     )
 import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
-import Darcs.Util.Printer ( Doc, renderPS, redText, greenText, ($$), text, vcat )
+import qualified Darcs.Util.Format as F ( toStrictByteString )
+import Darcs.Util.Printer
+    ( Doc
+    , greenText
+    , packedString
+    , redText
+    , text
+    , userchunkPS
+    , vcat
+    , ($$)
+    )
 --import Darcs.ColorPrinter ( traceDoc )
 
 import Test.QuickCheck (Property, checkCoverage, cover)
@@ -102,6 +113,67 @@ type MergeProperty p = forall wA wB. (FL p :\/: FL p) wA wB -> TestResult
 type SequenceProperty p = forall wA wB. RL p wA wB -> TestResult
 type SequencePairProperty p = forall wA wB. (RL p :> RL p) wA wB -> TestResult
 
+-- * Classifiers
+
+type Square p q wA wB wC wD = (p wA wB, q wB wD, q wA wC, p wC wD)
+
+-- | Both patches are unmodified
+trivial_square :: (Eq2 p, Eq2 q) => Square p q wA wB wC wD -> Bool
+trivial_square (x1, y1, y2, x2) =
+  x1 `unsafeCompare` x2 && y1 `unsafeCompare` y2
+
+classify_nontrivial_square
+  :: (Eq2 p, Eq2 q) => Square p q wA wB wC wD -> TestResult -> TestResult
+classify_nontrivial_square x =
+  classify (not (trivial_square x)) "nontrivial"
+
+-- | A commuting 'Cube' with all witnesses existentially hidden except those
+-- corresponding to the start state and the end state. The witnesses are named
+-- after the set of patches preceding it, with @wO@ corresponding to the origin
+-- and e.g. @wXY@ corresponding to the state after applying @x@ and @y@.
+data Cube p q r wO wXYZ where
+  Cube
+    :: p wO wX -> q wX wXY -> r wXY wXYZ  -- x, y, z
+    -> p wY wXY -> q wO wY -> r wY wYZ    -- x', ...
+    -> p wYZ wXYZ -> q wZ wYZ -> r wO wZ  -- x'', ...
+    -> p wZ wXZ -> q wXZ wXYZ -> r wX wXZ -- x''', ...
+    -> Cube p q r wO wXYZ
+
+-- | A 'Cube' is nontrivial (by definition) if, geometrically speaking,  for
+-- all three sets of parallel edges, not all of them are structurally equal.
+--
+-- In terms of patches, this means that all commutations involving the "same"
+-- pair of patches contain at least one nontrivial
+nontrivial_cube :: (Eq2 p, Eq2 q, Eq2 r) => Cube p q r wO wXYZ -> String
+nontrivial_cube (Cube x y z x' y' z' x'' y'' z'' x''' y''' z''') =
+ ("triviality index (0-3): " ++) $ show $ length $ filter id
+    [ trivial x x' x'' x'''
+    , trivial y y' y'' y'''
+    , trivial z z' z'' z'''
+    ]
+  where
+    trivial p p' p'' p''' =
+      and
+        [ unsafeCompare p p'
+        , unsafeCompare p p''
+        , unsafeCompare p p'''
+        , unsafeCompare p' p''
+        , unsafeCompare p' p'''
+        , unsafeCompare p'' p'''
+        ]
+
+classify_nontrivial_cube
+  :: (Eq2 p, Eq2 q, Eq2 r) => Cube p q r wO wXYZ -> TestResult -> TestResult
+classify_nontrivial_cube x =
+  classify True (nontrivial_cube x)
+
+-- * Helpers
+
+displayPatchFL :: ShowPatchBasic p => FL p wX wY -> Doc
+displayPatchFL = vcat . mapFL showPatch
+
+-- * Properties
+
 -- | @A^^=A@
 invertInvolution :: (Invert p, Eq2 p, ShowPatchBasic p) => p wA wB -> TestResult
 invertInvolution p =
@@ -110,11 +182,8 @@ invertInvolution p =
     IsEq  -> succeeded
     NotEq ->
       failed $ redText "p /= p^^, where"
-      $$ text "##p=" $$ displayPatch p
-      $$ text "##p^^=" $$ displayPatch p'
-
-displayPatchFL :: ShowPatchBasic p => FL p wX wY -> Doc
-displayPatchFL = vcat . mapFL displayPatch
+      $$ text "##p=" $$ showPatch p
+      $$ text "##p^^=" $$ showPatch p'
 
 -- | @(AB)^ = B^A^@
 inverseComposition :: (Invert p, Eq2 p, ShowPatchBasic p)
@@ -152,9 +221,9 @@ invertRollback (WithState a x b) =
         else
           failed $
             redText "##original repo a:" $$ text (showModel a) $$
-            redText "##with patch x:" $$ displayPatch x $$
+            redText "##with patch x:" $$ showPatch x $$
             redText "##results in b:" $$ text (showModel b) $$
-            redText "##but (invert x):" $$ displayPatch (invert x) $$
+            redText "##but (invert x):" $$ showPatch (invert x) $$
             redText "##applied to b is a':" $$ text (showModel a') $$
             redText "##which is not equal to a."
 
@@ -172,27 +241,28 @@ recommute c (Pair (x :> y)) =
       -- migration to a new patch type.
       | hasDuplicate y' || hasDuplicate x' -> rejected
       | otherwise ->
+       classify_nontrivial_square (x, y, y', x') $
        case c (y' :> x') of
-         Nothing -> failed (redText "failed, where x" $$ displayPatch x $$
-                              redText ":> y" $$ displayPatch y $$
-                              redText "y'" $$ displayPatch y' $$
-                              redText ":> x'" $$ displayPatch x')
+         Nothing -> failed (redText "failed, where x" $$ showPatch x $$
+                              redText ":> y" $$ showPatch y $$
+                              redText "y'" $$ showPatch y' $$
+                              redText ":> x'" $$ showPatch x')
          Just (x'' :> y'') ->
              case y'' =/\= y of
-             NotEq -> failed (redText "y'' =/\\= y failed, where x" $$ displayPatch x $$
-                              redText ":> y" $$ displayPatch y $$
-                              redText "y'" $$ displayPatch y' $$
-                              redText ":> x'" $$ displayPatch x' $$
-                              redText "x''" $$ displayPatch x'' $$
-                              redText ":> y''" $$ displayPatch y'')
+             NotEq -> failed (redText "y'' =/\\= y failed, where x" $$ showPatch x $$
+                              redText ":> y" $$ showPatch y $$
+                              redText "y'" $$ showPatch y' $$
+                              redText ":> x'" $$ showPatch x' $$
+                              redText "x''" $$ showPatch x'' $$
+                              redText ":> y''" $$ showPatch y'')
              IsEq -> case x'' =/\= x of
                      NotEq -> failed (
-                              redText "x'' /= x, where x" $$ displayPatch x $$
-                              redText ":> y" $$ displayPatch y $$
-                              redText "y'" $$ displayPatch y' $$
-                              redText ":> x'" $$ displayPatch x' $$
-                              redText "x''" $$ displayPatch x'' $$
-                              redText ":> y''" $$ displayPatch y'')
+                              redText "x'' /= x, where x" $$ showPatch x $$
+                              redText ":> y" $$ showPatch y $$
+                              redText "y'" $$ showPatch y' $$
+                              redText ":> x'" $$ showPatch x' $$
+                              redText "x''" $$ showPatch x'' $$
+                              redText ":> y''" $$ showPatch y'')
                      IsEq -> succeeded
 
 -- | commuteInverses   AB ↔ B′A′ if and only if B⁻¹A⁻¹ ↔ A′⁻¹B′⁻¹
@@ -206,66 +276,66 @@ commuteInverses c (Pair (x :> y)) =
       case c (invert y :> invert x) of
         Just _ -> failed $
           redText "second commute did not fail"
-          $$ redText "x" $$ displayPatch x
-          $$ redText "y" $$ displayPatch y
-          $$ redText "invert y" $$ displayPatch (invert y)
-          $$ redText "invert x" $$ displayPatch (invert x)
+          $$ redText "x" $$ showPatch x
+          $$ redText "y" $$ showPatch y
+          $$ redText "invert y" $$ showPatch (invert y)
+          $$ redText "invert x" $$ showPatch (invert x)
         Nothing -> succeeded
     Just (y' :> x') ->
+        classify_nontrivial_square (x, y, y', x') $
         case c (invert y :> invert x) of
         Nothing -> failed $ redText "second commute failed" $$
-                            redText "x" $$ displayPatch x $$ redText "y" $$ displayPatch y $$
-                            redText "invert y" $$ displayPatch (invert y) $$ redText "invert x" $$ displayPatch (invert x)
+                            redText "x" $$ showPatch x $$ redText "y" $$ showPatch y $$
+                            redText "invert y" $$ showPatch (invert y) $$ redText "invert x" $$ showPatch (invert x)
         Just (ix' :> iy') ->
             case invert ix' =/\= x' of
             NotEq -> failed $ redText "invert ix' /= x'" $$
-                              redText "x" $$ displayPatch x $$
-                              redText "y" $$ displayPatch y $$
-                              redText "y'" $$ displayPatch y' $$
-                              redText "x'" $$ displayPatch x' $$
-                              redText "ix'" $$ displayPatch ix' $$
-                              redText "iy'" $$ displayPatch iy' $$
-                              redText "invert ix'" $$ displayPatch (invert ix') $$
-                              redText "invert iy'" $$ displayPatch (invert iy')
+                              redText "x" $$ showPatch x $$
+                              redText "y" $$ showPatch y $$
+                              redText "y'" $$ showPatch y' $$
+                              redText "x'" $$ showPatch x' $$
+                              redText "ix'" $$ showPatch ix' $$
+                              redText "iy'" $$ showPatch iy' $$
+                              redText "invert ix'" $$ showPatch (invert ix') $$
+                              redText "invert iy'" $$ showPatch (invert iy')
             IsEq -> case y' =\/= invert iy' of
-                    NotEq -> failed $ redText "y' /= invert iy'" $$ displayPatch iy' $$ displayPatch y'
+                    NotEq -> failed $ redText "y' /= invert iy'" $$ showPatch iy' $$ showPatch y'
                     IsEq -> succeeded
 
--- | effect preserving  AB <--> B'A' then effect(AB) = effect(B'A')
+-- | effect preserving: @AB <--> B'A' => apply(AB) = apply(B'A')@
 effectPreserving
-  :: ( MightBeEmptyHunk p
-     , RepoModel model
+  :: ( RepoModel model
      , model ~ ModelOf p
      , ApplyState p ~ RepoState model
      , ShowPatchBasic p
      , RepoApply p
+     , Eq2 p
      )
   => CommuteFn p p
   -> WithState (Pair p) wA wB
   -> TestResult
-effectPreserving _ (WithState _ (Pair (x :> _)) _)
-  | isEmptyHunk x = rejected
 effectPreserving c (WithState r (Pair (x :> y)) r') =
   case c (x :> y) of
     Nothing -> rejected
     Just (y' :> x') ->
+      classify_nontrivial_square (x, y, y', x') $
       case maybeFail $ repoApply r y' of
         Nothing ->
           failed
-          $  redText "##x" $$ displayPatch x
-          $$ redText "##y" $$ displayPatch y
-          $$ redText "##y'" $$ displayPatch y'
-          $$ redText "##x'" $$ displayPatch x'
+          $  redText "##x" $$ showPatch x
+          $$ redText "##y" $$ showPatch y
+          $$ redText "##y'" $$ showPatch y'
+          $$ redText "##x'" $$ showPatch x'
           $$ redText "##y' is not applicable to r"
           $$ displayModel r
         Just r_y' ->
           case maybeFail $ repoApply r_y' x' of
             Nothing ->
               failed
-              $  redText "##x" $$ displayPatch x
-              $$ redText "##y" $$ displayPatch y
-              $$ redText "##y'" $$ displayPatch y'
-              $$ redText "##x'" $$ displayPatch x'
+              $  redText "##x" $$ showPatch x
+              $$ redText "##y" $$ showPatch y
+              $$ redText "##y'" $$ showPatch y'
+              $$ redText "##x'" $$ showPatch x'
               $$ redText "##x' is not applicable to r_y'"
               $$ displayModel r_y'
             Just r_y'x' ->
@@ -273,10 +343,10 @@ effectPreserving c (WithState r (Pair (x :> y)) r') =
                 then succeeded
                 else
                   failed
-                  $  redText "##x" $$ displayPatch x
-                  $$ redText "##y" $$ displayPatch y
-                  $$ redText "##y'" $$ displayPatch y'
-                  $$ redText "##x'" $$ displayPatch x'
+                  $  redText "##x" $$ showPatch x
+                  $$ redText "##y" $$ showPatch y
+                  $$ redText "##y'" $$ showPatch y'
+                  $$ redText "##x'" $$ showPatch x'
                   $$ redText "##r_y'x'"
                   $$ displayModel r_y'x'
                   $$ redText "##is not equal to r'"
@@ -294,36 +364,37 @@ squareCommuteLaw c (Pair (x :> y)) =
   case c (x :> y) of
     Nothing -> rejected
     Just (y' :> x') ->
+      classify_nontrivial_square (x, y, y', x') $
       case c (invert x :> y') of
         Nothing ->
           failed $
           redText "-------- original (x :> y)" $$
-          displayPatch x $$ redText ":>" $$ displayPatch y $$
+          showPatch x $$ redText ":>" $$ showPatch y $$
           redText "-------- result (y' :> x')" $$
-          displayPatch y' $$ redText ":>" $$ displayPatch x' $$
+          showPatch y' $$ redText ":>" $$ showPatch x' $$
           redText "-------- failed commute (invert x :> y')" $$
-          displayPatch (invert x) $$ redText ":>" $$ displayPatch y'
+          showPatch (invert x) $$ redText ":>" $$ showPatch y'
         Just (y'' :> ix') ->
           case y'' =\/= y of
             NotEq ->
               failed $ redText "y'' /= y" $$
-              redText "x" $$ displayPatch x $$
-              redText "y" $$ displayPatch y $$
-              redText "y'" $$ displayPatch y' $$
-              redText "x'" $$ displayPatch x' $$
-              redText "y''" $$ displayPatch y'' $$
-              redText "ix'" $$ displayPatch ix'
+              redText "x" $$ showPatch x $$
+              redText "y" $$ showPatch y $$
+              redText "y'" $$ showPatch y' $$
+              redText "x'" $$ showPatch x' $$
+              redText "y''" $$ showPatch y'' $$
+              redText "ix'" $$ showPatch ix'
             IsEq ->
               case x' =\/= invert ix' of
                 NotEq ->
                   failed $ redText "x' /= invert ix'" $$
-                  redText "x" $$ displayPatch x $$
-                  redText "y" $$ displayPatch y $$
-                  redText "y'" $$ displayPatch y' $$
-                  redText "x'" $$ displayPatch x' $$
-                  redText "invert x" $$ displayPatch (invert x) $$
-                  redText "y'" $$ displayPatch y' $$
-                  redText "invert ix'" $$ displayPatch (invert ix')
+                  redText "x" $$ showPatch x $$
+                  redText "y" $$ showPatch y $$
+                  redText "y'" $$ showPatch y' $$
+                  redText "x'" $$ showPatch x' $$
+                  redText "invert x" $$ showPatch (invert x) $$
+                  redText "y'" $$ showPatch y' $$
+                  redText "invert ix'" $$ showPatch (invert ix')
                 IsEq -> succeeded
 
 permutivity :: (ShowPatchBasic p, Eq2 p)
@@ -340,103 +411,108 @@ permutivity c (x :> y :> z) =
       Nothing ->
         case c (x1 :> z) of
           Just _ -> failed $ redText "##partial permutivity:" $$
-            redText "##x" $$ displayPatch x $$
-            redText "##y" $$ displayPatch y $$
-            redText "##z" $$ displayPatch z $$
-            redText "##y1" $$ displayPatch y1 $$
-            redText "##x1" $$ displayPatch x1 $$
-            redText "##z2" $$ displayPatch z2 $$
-            redText "##y2" $$ displayPatch y2 $$
+            redText "##x" $$ showPatch x $$
+            redText "##y" $$ showPatch y $$
+            redText "##z" $$ showPatch z $$
+            redText "##y1" $$ showPatch y1 $$
+            redText "##x1" $$ showPatch x1 $$
+            redText "##z2" $$ showPatch z2 $$
+            redText "##y2" $$ showPatch y2 $$
             redText "##x :> z2 does not commute, whereas x1 :> z does"
-          Nothing -> succeeded
+          Nothing -> classify True "partial" succeeded
       Just (z3 :> x3) ->
         case c (x1 :> z) of
           Nothing ->
             failed $ redText "##permutivity1:" $$
-              redText "##x" $$ displayPatch x $$
-              redText "##y" $$ displayPatch y $$
-              redText "##z" $$ displayPatch z $$
-              redText "##y1" $$ displayPatch y1 $$
-              redText "##y2" $$ displayPatch y2 $$
+              redText "##x" $$ showPatch x $$
+              redText "##y" $$ showPatch y $$
+              redText "##z" $$ showPatch z $$
+              redText "##y1" $$ showPatch y1 $$
+              redText "##y2" $$ showPatch y2 $$
               redText "##failed commute with z of" $$
-              redText "##x1" $$ displayPatch x1 $$
+              redText "##x1" $$ showPatch x1 $$
               redText "##whereas x commutes with" $$
-              redText "##z2" $$ displayPatch z2
+              redText "##z2" $$ showPatch z2
           Just (z4 :> x4) ->
             --traceDoc (greenText "third commuted" $$
             --          greenText "about to commute" $$
-            --          greenText "y1" $$ displayPatch y1 $$
-            --          greenText "z4" $$ displayPatch z4) $
+            --          greenText "y1" $$ showPatch y1 $$
+            --          greenText "z4" $$ showPatch z4) $
             case c (y1 :> z4) of
             Nothing ->
               failed $ redText "##permutivity2:" $$
                 redText "##failed to commute y1 with z4, where" $$
-                redText "##x" $$ displayPatch x $$
-                redText "##y" $$ displayPatch y $$
-                redText "##z" $$ displayPatch z $$
-                redText "##y1" $$ displayPatch y1 $$
-                redText "##x1" $$ displayPatch x1 $$
-                redText "##z2" $$ displayPatch z2 $$
-                redText "##y2" $$ displayPatch y2 $$
-                redText "##z3" $$ displayPatch z3 $$
-                redText "##x3" $$ displayPatch x3 $$
-                redText "##z4" $$ displayPatch z4 $$
-                redText "##x4" $$ displayPatch x4
+                redText "##x" $$ showPatch x $$
+                redText "##y" $$ showPatch y $$
+                redText "##z" $$ showPatch z $$
+                redText "##y1" $$ showPatch y1 $$
+                redText "##x1" $$ showPatch x1 $$
+                redText "##z2" $$ showPatch z2 $$
+                redText "##y2" $$ showPatch y2 $$
+                redText "##z3" $$ showPatch z3 $$
+                redText "##x3" $$ showPatch x3 $$
+                redText "##z4" $$ showPatch z4 $$
+                redText "##x4" $$ showPatch x4
             Just (z3_ :> y4)
                 | IsEq <- z3_ =\/= z3 ->
                      --traceDoc (greenText "passed z3") $ error "foobar test" $
                      case c (y4 :> x4) of
                      Nothing -> failed $
                         redText "##permutivity5: input was" $$
-                        redText "##x" $$ displayPatch x $$
-                        redText "##y" $$ displayPatch y $$
-                        redText "##z" $$ displayPatch z $$
-                        redText "##z3" $$ displayPatch z3 $$
-                        redText "##z4" $$ displayPatch z4 $$
+                        redText "##x" $$ showPatch x $$
+                        redText "##y" $$ showPatch y $$
+                        redText "##z" $$ showPatch z $$
+                        redText "##z3" $$ showPatch z3 $$
+                        redText "##z4" $$ showPatch z4 $$
                         redText "##failed commute of" $$
-                        redText "##y4" $$ displayPatch y4 $$
-                        redText "##x4" $$ displayPatch x4 $$
+                        redText "##y4" $$ showPatch y4 $$
+                        redText "##x4" $$ showPatch x4 $$
                         redText "##whereas commute of x and y give" $$
-                        redText "##y1" $$ displayPatch y1 $$
-                        redText "##x1" $$ displayPatch x1
+                        redText "##y1" $$ showPatch y1 $$
+                        redText "##x1" $$ showPatch x1
                      Just (x3_ :> y2_)
                           | NotEq <- x3_ =\/= x3 ->
                               failed $
                                 redText "##permutivity6: x3_ /= x3" $$
-                                redText "##x3_" $$ displayPatch x3_ $$
-                                redText "##x3" $$ displayPatch x3
+                                redText "##x3_" $$ showPatch x3_ $$
+                                redText "##x3" $$ showPatch x3
                           | NotEq <- y2_ =/\= y2 ->
                               failed $
                                 redText "##permutivity7: y2_ /= y2" $$
-                                redText "##y2_" $$ displayPatch y2_ $$
-                                redText "##y2" $$ displayPatch y2
-                          | otherwise -> succeeded
+                                redText "##y2_" $$ showPatch y2_ $$
+                                redText "##y2" $$ showPatch y2
+                          | otherwise ->
+                              classify_nontrivial_cube
+                                (Cube y1 x1 z y x z2 y2 x3 z3 y4 x4 z4) succeeded
                 | otherwise ->
                     failed $ redText "##permutivity failed" $$
-                             redText "##z3" $$ displayPatch z3 $$
-                             redText "##z3_" $$ displayPatch z3_
+                             redText "##z3" $$ showPatch z3 $$
+                             redText "##z3_" $$ showPatch z3_
 
 mergeArgumentsConsistent :: (ShowPatchBasic p) =>
                               (forall wX wY . p wX wY -> Maybe Doc)
                            -> (p :\/: p) wA wB -> TestResult
 mergeArgumentsConsistent isConsistent (x :\/: y) =
   maybeFailed $
-    msum [(\z -> redText "mergeArgumentsConsistent x" $$ displayPatch x $$ z) `fmap` isConsistent x,
-          (\z -> redText "mergeArgumentsConsistent y" $$ displayPatch y $$ z) `fmap` isConsistent y]
+    msum [(\z -> redText "mergeArgumentsConsistent x" $$ showPatch x $$ z) `fmap` isConsistent x,
+          (\z -> redText "mergeArgumentsConsistent y" $$ showPatch y $$ z) `fmap` isConsistent y]
 
-mergeConsistent :: (ShowPatchBasic p, Merge p) =>
-                           (forall wX wY . p wX wY -> Maybe Doc)
-                        -> (p :\/: p) wA wB -> TestResult
+mergeConsistent
+  :: (Eq2 p, ShowPatchBasic p, Merge p)
+  => (forall wX wY . p wX wY -> Maybe Doc)
+  -> (p :\/: p) wA wB
+  -> TestResult
 mergeConsistent isConsistent (x :\/: y) =
     case merge (x :\/: y) of
     y' :/\: x' ->
+      classify_nontrivial_square (x, y', y, x') $
       maybeFailed $
-        msum [(\z -> redText "mergeConsistent x" $$ displayPatch x $$ z) `fmap` isConsistent x,
-              (\z -> redText "mergeConsistent y" $$ displayPatch y $$ z) `fmap` isConsistent y,
-              (\z -> redText "mergeConsistent x'" $$ displayPatch x' $$ z $$
-                     redText "where x' comes from x" $$ displayPatch x $$
-                     redText "and y" $$ displayPatch y) `fmap` isConsistent x',
-              (\z -> redText "mergeConsistent y'" $$ displayPatch y' $$ z) `fmap` isConsistent y']
+        msum [(\z -> redText "mergeConsistent x" $$ showPatch x $$ z) `fmap` isConsistent x,
+              (\z -> redText "mergeConsistent y" $$ showPatch y $$ z) `fmap` isConsistent y,
+              (\z -> redText "mergeConsistent x'" $$ showPatch x' $$ z $$
+                     redText "where x' comes from x" $$ showPatch x $$
+                     redText "and y" $$ showPatch y) `fmap` isConsistent x',
+              (\z -> redText "mergeConsistent y'" $$ showPatch y' $$ z) `fmap` isConsistent y']
 
 -- merge (A\/B) = B'/\A' <==> merge (B\/A) = A'/\B'
 --  or, equivalently,
@@ -449,21 +525,22 @@ mergeEitherWay :: (Eq2 p, ShowPatchBasic p, Merge p)
 mergeEitherWay (x :\/: y) =
   case merge (x :\/: y) of
     y' :/\: x' ->
+      classify_nontrivial_square (x, y', y, x') $
       case merge (y :\/: x) of
         x'' :/\: y''
           | IsEq <- x'' =\/= x'
           , IsEq <- y'' =\/= y' -> succeeded
           | otherwise ->
             failed $
-              redText "##x" $$ displayPatch x $$
-              redText "##y" $$ displayPatch y $$
-              redText "##y'" $$ displayPatch y' $$
-              redText "##x'" $$ displayPatch x' $$
-              redText "##x''" $$ displayPatch x'' $$
-              redText "##y''" $$ displayPatch y'' $$
+              redText "##x" $$ showPatch x $$
+              redText "##y" $$ showPatch y $$
+              redText "##y'" $$ showPatch y' $$
+              redText "##x'" $$ showPatch x' $$
+              redText "##x''" $$ showPatch x'' $$
+              redText "##y''" $$ showPatch y'' $$
               redText "##x'' /= x' or y'' /= y'"
 
--- merge (A\/B) = B'/\A' ==> AB' <--> BA'
+-- | @merge (A\/B) = B'/\A' ==> AB' <--> BA'@
 mergeCommute :: (Eq2 p, ShowPatchBasic p, Commute p, Merge p, MightHaveDuplicate p)
              => (p :\/: p) wX wY -> TestResult
 mergeCommute (x :\/: y) =
@@ -475,43 +552,48 @@ mergeCommute (x :\/: y) =
      -- migration to a new patch type.
      | hasDuplicate x' || hasDuplicate y' -> rejected
      | otherwise ->
+        classify_nontrivial_square (x, y', y, x') $
         case commute (x :> y') of
         Nothing -> failed $ redText "mergeCommute 1" $$
-                            redText "x" $$ displayPatch x $$
-                            redText "y" $$ displayPatch y $$
-                            redText "x'" $$ displayPatch x' $$
-                            redText "y'" $$ displayPatch y'
+                            redText "x" $$ showPatch x $$
+                            redText "y" $$ showPatch y $$
+                            redText "x'" $$ showPatch x' $$
+                            redText "y'" $$ showPatch y'
         Just (y_ :> x'_)
             | IsEq <- y_ =\/= y,
               IsEq <- x'_ =\/= x' ->
                       case commute (y :> x') of
                       Nothing -> failed $ redText "mergeCommute 2 failed" $$
-                                          redText "x" $$ displayPatch x $$
-                                          redText "y" $$ displayPatch y $$
-                                          redText "x'" $$ displayPatch x' $$
-                                          redText "y'" $$ displayPatch y'
+                                          redText "x" $$ showPatch x $$
+                                          redText "y" $$ showPatch y $$
+                                          redText "x'" $$ showPatch x' $$
+                                          redText "y'" $$ showPatch y'
                       Just (x_ :> y'_)
                            | IsEq <- x_ =\/= x,
                              IsEq <- y'_ =\/= y' -> succeeded
                            | otherwise -> failed $ redText "mergeCommute 3" $$
-                                                   redText "x" $$ displayPatch x $$
-                                                   redText "y" $$ displayPatch y $$
-                                                   redText "x'" $$ displayPatch x' $$
-                                                   redText "y'" $$ displayPatch y' $$
-                                                   redText "x_" $$ displayPatch x_ $$
-                                                   redText "y'_" $$ displayPatch y'_
+                                                   redText "x" $$ showPatch x $$
+                                                   redText "y" $$ showPatch y $$
+                                                   redText "x'" $$ showPatch x' $$
+                                                   redText "y'" $$ showPatch y' $$
+                                                   redText "x_" $$ showPatch x_ $$
+                                                   redText "y'_" $$ showPatch y'_
             | otherwise -> failed $ redText "mergeCommute 4" $$
-                                    redText "x" $$ displayPatch x $$
-                                    redText "y" $$ displayPatch y $$
-                                    redText "x'" $$ displayPatch x' $$
-                                    redText "y'" $$ displayPatch y' $$
-                                    redText "x'_" $$ displayPatch x'_ $$
-                                    redText "y_" $$ displayPatch y_
+                                    redText "x" $$ showPatch x $$
+                                    redText "y" $$ showPatch y $$
+                                    redText "x'" $$ showPatch x' $$
+                                    redText "y'" $$ showPatch y' $$
+                                    redText "x'_" $$ showPatch x'_ $$
+                                    redText "y_" $$ showPatch y_
 
 
--- | coalesce effect preserving
+-- | Coalescing is effect preserving
 coalesceEffectPreserving
-  :: (TestablePrim prim, RepoApply prim)
+  :: ( ShowPatchBasic prim
+     , ApplyState prim ~ RepoState (ModelOf prim)
+     , RepoModel (ModelOf prim)
+     , RepoApply prim
+     )
   => (forall wX wY . (prim :> prim) wX wY -> Maybe (FL prim wX wY))
   -> WithState (Pair prim) wA wB
   -> TestResult
@@ -521,9 +603,9 @@ coalesceEffectPreserving j (WithState r (Pair (a :> b)) r') =
        Just x  -> case maybeFail $ repoApply r x of
                        Nothing  -> failed $ redText "x is not applicable to r."
                                         $$ text (showModel r)
-                                        $$ displayPatch x
+                                        $$ showPatch x
                                         $$ redText "a:>b"
-                                        $$ displayPatch a $$ displayPatch b
+                                        $$ showPatch a $$ showPatch b
                                         $$ redText "r'="
                                         $$ text (showModel r')
                        Just r_x -> if r_x `eqModel` r'
@@ -531,19 +613,22 @@ coalesceEffectPreserving j (WithState r (Pair (a :> b)) r') =
                                       else failed $ redText "r_x /= r', r="
                                         $$ text (showModel r)
                                         $$ redText "a:>b="
-                                        $$ displayPatch a $$ displayPatch b
+                                        $$ showPatch a $$ showPatch b
                                         $$ redText "x="
-                                        $$ displayPatch x
+                                        $$ showPatch x
                                         $$ redText "r'="
                                         $$ text (showModel r')
                                         $$ redText "r_x="
                                         $$ text (showModel r_x)
 
+-- | Just X = coalesce (BC), A(BC) <--> (B'C')A', AX <--> X'A''
+--   ==>
+--   A' = A'', coalesce (B'C') = Just X'
 coalesceCommute
-          :: (TestablePrim prim, MightBeEmptyHunk prim)
-          => (forall wX wY . (prim :> prim) wX wY -> Maybe (FL prim wX wY))
-          -> (prim :> prim :> prim) wA wB -> TestResult
-coalesceCommute _ (a :> _ :> _) | isEmptyHunk a = rejected
+  :: (Commute prim, Eq2 prim, ShowPatchBasic prim)
+  => (forall wX wY . (prim :> prim) wX wY -> Maybe (FL prim wX wY))
+  -> (prim :> prim :> prim) wA wB
+  -> TestResult
 coalesceCommute j (a :> b :> c) =
     case j (b :> c) of
     Nothing -> rejected
@@ -573,84 +658,103 @@ coalesceCommute j (a :> b :> c) =
                         IsEq -> succeeded
                       where
                         display3 = redText "## coalesce (b':>c') => x''"
-                                   $$ displayPatch x''
+                                   $$ showPatch x''
               where
                 display2 =
-                     redText "## commute (a:>x) => x'" $$ displayPatch x'
-                  $$ redText "## :> a''" $$ displayPatch a''
+                     redText "## commute (a:>x) => x'" $$ showPatch x'
+                  $$ redText "## :> a''" $$ showPatch a''
             _ -> failed $ greenText "commute a x failed" $$ display1
           where
             display1 =
-                 redText "## a" $$ displayPatch a
-              $$ redText "## b" $$ displayPatch b
-              $$ redText "## c" $$ displayPatch c
-              $$ redText "## coalesce (b:>c) => x" $$ displayPatch x
-              $$ redText "## commute (a:>b:>c) => a'" $$ displayPatch a'
-              $$ redText "## b'" $$ displayPatch b'
-              $$ redText "## c'" $$ displayPatch c'
+                 redText "## a" $$ showPatch a
+              $$ redText "## b" $$ showPatch b
+              $$ redText "## c" $$ showPatch c
+              $$ redText "## coalesce (b:>c) => x" $$ showPatch x
+              $$ redText "## commute (a:>b:>c) => a'" $$ showPatch a'
+              $$ redText "## b'" $$ showPatch b'
+              $$ redText "## c'" $$ showPatch c'
         _ -> rejected
 
--- note: we would normally use displayPatch in the failure message
--- but that would be very misleading here
-showRead :: (Show2 p, Eq2 p, ReadPatch p, ShowPatchBasic p) => p wA wB -> TestResult
-showRead p =
-  let ps = renderPS (showPatch ForStorage p)
+formatRead :: (Show2 p, Eq2 p, ReadPatch p, FormatPatch p) => p wA wB -> TestResult
+formatRead p =
+  let ps = F.toStrictByteString (formatPatch p)
    in case readPatch ps of
-        Left e -> failed (redText "unable to read " $$ showPatch ForStorage p $$ text e)
+        Left e -> failed (redText "unable to read " $$ packedString ps $$ text e)
         Right (Sealed p')
           | IsEq <- p' =\/= p -> succeeded
           | otherwise ->
-            failed $
-            redText "##trouble reading patch p" $$ showPatch ForStorage p $$
-            redText "##reads as p'" $$
-            showPatch ForStorage p' $$
-            redText "##aka" $$
-            greenText (show2 p) $$
-            redText "##and" $$
-            greenText (show2 p')
+            failed $ vcat
+              [ redText "patch p"
+              , text (show2 p)
+              , redText "serialized as"
+              , userchunkPS ps
+              , redText "reads as p'"
+              , text (show2 p')
+              ]
 
 -- vim: fileencoding=utf-8 :
 
 mergeEitherWayValid
-  :: (Check p, Merge p, Invert p, ShowPatchBasic p)
+  :: (Check p, Eq2 p, Merge p, Invert p, ShowPatchBasic p)
   => (p :\/: p) wX wY
   -> TestResult
 mergeEitherWayValid (p1 :\/: p2) =
   case merge (p1 :\/: p2) of
-    _ :/\: p1' ->
+    p2' :/\: p1' ->
+      classify_nontrivial_square (p1, p2', p2, p1') $
       case p2 :>: p1' :>: NilFL of
         combo2 ->
           case merge (p2 :\/: p1) of
-            _ :/\: p2' ->
-              case p1 :>: p2' :>: NilFL of
+            _ :/\: p2'' ->
+              case p1 :>: p2'' :>: NilFL of
                 combo1
                   | not $ checkAPatch combo1 ->
                       failed $ text "combo1 invalid: p1="
-                      $$ displayPatch p1
+                      $$ showPatch p1
                       $$ text "p2="
-                      $$ displayPatch p2
+                      $$ showPatch p2
                       $$ text "combo1="
-                      $$ vcat (mapFL displayPatch combo1)
+                      $$ vcat (mapFL showPatch combo1)
                   | checkAPatch (invert combo1 :>: combo2 :>: NilFL) ->
                       succeeded
                   | otherwise ->
                       failed $ text "merge both ways invalid: p1="
-                      $$ displayPatch p1
+                      $$ showPatch p1
                       $$ text "p2="
-                      $$ displayPatch p2
+                      $$ showPatch p2
                       $$ text "combo1="
-                      $$ vcat (mapFL displayPatch combo1)
+                      $$ vcat (mapFL showPatch combo1)
                       $$ text "combo2="
-                      $$ vcat (mapFL displayPatch combo2)
+                      $$ vcat (mapFL showPatch combo2)
 
 inverseDoesntCommute :: (ShowPatchBasic p, Invert p, Commute p)
                      => p wY1 wY2 -> TestResult
 inverseDoesntCommute x =
   case commute (x :> invert x) of
     Nothing -> succeeded
-    Just (ix' :> x') -> failed $ redText "x:" $$ displayPatch x
-      $$ redText "commutes with x^ to ix':" $$ displayPatch ix'
-      $$ redText "x':" $$ displayPatch x'
+    Just (ix' :> x') -> failed $ redText "x:" $$ showPatch x
+      $$ redText "commutes with x^ to ix':" $$ showPatch ix'
+      $$ redText "x':" $$ showPatch x'
+
+-- | This property states that two patches cannot both commute and coalesce.
+-- It has a single exception for Prim.V1, namely adjacent
+-- hunks that both add and remove lines.
+notCoalesceAndCommute
+  :: (Eq (ObjectIdOfPatch p), IsHunk p, PrimCoalesce p, ShowPatchBasic p)
+  => Pair p wX wY -> TestResult
+notCoalesceAndCommute (Pair pair@(p1 :> p2))
+  | Just (FileHunk _ f1 l1 (length -> o1) (length -> n1)) <- isHunk p1
+  , Just (FileHunk _ f2 l2 (length -> o2) (length -> n2)) <- isHunk p2
+  , f1 == f2
+  , l1 + n1 == l2 || l2 + o2 == l1
+  , o1 > 0, n1 > 0, o2 > 0, n2 > 0 = rejected
+  | Just _ <- commute pair
+  , Just _ <- primCoalesce p1 p2 =
+      failed $
+        text "patches coalesce and commute:" $$
+        showPatch p1 $$
+        showPatch p2
+  | otherwise = succeeded
 
 -- This property is just to check the coverage of pairs,
 -- it doesn't test any actual property.
diff --git a/harness/Darcs/Test/Patch/Properties/Mergeable.hs b/harness/Darcs/Test/Patch/Properties/Mergeable.hs
index 7bad8d7a..22f3a1c9 100644
--- a/harness/Darcs/Test/Patch/Properties/Mergeable.hs
+++ b/harness/Darcs/Test/Patch/Properties/Mergeable.hs
@@ -6,36 +6,50 @@ module Darcs.Test.Patch.Properties.Mergeable
     , FromPrimT
     ) where
 
-import Prelude ()
 import Darcs.Prelude
 
 import Data.Maybe ( catMaybes )
 import Safe ( tailErr )
 
-import Darcs.Test.Patch.Arbitrary.Generic ( PrimBased )
-import Darcs.Test.Patch.Arbitrary.PatchTree
-  ( Tree, flattenTree, G2(..), mapTree )
-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
-  ( 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 ( ConflictDetails(..), Unravelled )
 import Darcs.Patch.Merge ( CleanMerge, mergeList )
 import Darcs.Patch.Permutations ( permutationsRL, (=\~/=) )
 import Darcs.Patch.RepoPatch
-import Darcs.Patch.Show ( displayPatch )
-
+    ( ApplyState
+    , Commute
+    , Conflict(..)
+    , Eq2
+    , Merge
+    , PrimOf
+    , ShowPatchBasic
+    )
+import Darcs.Patch.Show ( showPatch )
 import Darcs.Patch.Witnesses.Eq ( isIsEq )
 import Darcs.Patch.Witnesses.Ordered ( RL(..), (:>)(..) )
-import Darcs.Patch.Witnesses.Sealed ( Sealed(..), unseal, Sealed2(..) )
+import Darcs.Patch.Witnesses.Sealed ( Sealed(..), Sealed2(..), unseal )
 import Darcs.Patch.Witnesses.Show ( Show2 )
+import Darcs.Util.Printer ( redText, text, vsep, ($$) )
+
+import Darcs.Test.Patch.Arbitrary.Generic ( PrimBased )
+import Darcs.Test.Patch.Arbitrary.PatchTree ( G2(..), Tree, flattenTree, mapTree )
+import Darcs.Test.Patch.Merge.Checked ( CheckedMerge )
+import Darcs.Test.Patch.RepoModel
+    ( Fail
+    , ModelOf
+    , RepoApply
+    , RepoModel
+    , RepoState
+    , eqModel
+    , maybeFail
+    , repoApply
+    , showModel
+    )
+import Darcs.Test.Patch.Types.MergeableSequence
+    ( MergeableSequence
+    , mergeableSequenceToRL
+    )
+import Darcs.Test.Patch.WithState
+import Darcs.Test.Util.TestResult ( TestResult, failed, rejected, succeeded )
 
 assertEqualFst :: (RepoModel a, Show b, Show c) => (Fail (a x), b) -> (Fail (a x), c) -> Bool
 assertEqualFst (x,bx) (y,by)
@@ -111,9 +125,6 @@ propResolutionsOrderIndependent
   :: ( Commute p
      , Conflict p
      , ShowPatchBasic p
-     , PatchListFormat p
-     , PatchListFormat (PrimOf p)
-     , ShowPatchBasic (PrimOf p)
      , Eq2 (PrimOf p)
      , Show2 (PrimOf p)
      , Commute (PrimOf p)
@@ -147,9 +158,9 @@ propResolutionsOrderIndependent (ctx :> ps) =
     displayPair (as :> bs) =
       vsep
         [ text "for context"
-        , displayPatch as
+        , showPatch as
         , text "and patches"
-        , displayPatch bs
+        , showPatch bs
         ]
 
 -- | Equality for 'Unravelled' is modulo order of patches.
@@ -167,10 +178,8 @@ listEqBy _ _ _ = False
 -- sequence of patches do not themselves conflict with each other.
 propResolutionsDontConflict
   :: ( Conflict p
-     , PatchListFormat p
      , ShowPatchBasic p
      , CleanMerge (PrimOf p)
-     , PatchListFormat (PrimOf p)
      , ShowPatchBasic (PrimOf p)
      )
   => RL p wX wY
@@ -181,8 +190,8 @@ propResolutionsDontConflict patches =
     Left (Sealed ps, Sealed qs) ->
       failed
         $ redText "resolutions conflict:"
-        $$ displayPatch ps
+        $$ showPatch ps
         $$ redText "conflicts with"
-        $$ displayPatch qs
+        $$ showPatch qs
         $$ redText "for sequence"
-        $$ displayPatch patches
+        $$ showPatch patches
diff --git a/harness/Darcs/Test/Patch/Properties/RepoPatchV3.hs b/harness/Darcs/Test/Patch/Properties/RepoPatchV3.hs
index f8a391e6..c584a0fa 100644
--- a/harness/Darcs/Test/Patch/Properties/RepoPatchV3.hs
+++ b/harness/Darcs/Test/Patch/Properties/RepoPatchV3.hs
@@ -15,7 +15,7 @@ import Darcs.Patch.Ident
 import Darcs.Patch.Invert
 import Darcs.Patch.Permutations ( headPermutationsRL, partitionRL' )
 import Darcs.Patch.Prim ( PrimPatch )
-import Darcs.Patch.Show ( displayPatch, ShowPatchFor(..) )
+import Darcs.Patch.Show ( showPatch )
 import Darcs.Patch.Witnesses.Ordered
 import Darcs.Patch.V3 ( RepoPatchV3 )
 import Darcs.Patch.V3.Contexted
@@ -70,9 +70,9 @@ prop_onlyFirstConflictorReverts ps p
   | S.null doubly_reverted = succeeded
   | otherwise = failed
       $ text "undone patches are already undone:"
-      $$ vcat (map (showId ForStorage) (S.toList doubly_reverted))
+      $$ vcat (map showId (S.toList doubly_reverted))
       $$ text "in the sequence:"
-      $$ vcat (mapRL displayPatch (ps :<: p))
+      $$ vcat (mapRL showPatch (ps :<: p))
   where
     doubly_reverted = S.intersection this_rids preceding_rids
     this_rids = revertedIds p
@@ -94,11 +94,11 @@ prop_conflictsCommutePastConflictor ps p
   | not (xids `S.isSubsetOf` rids)
   = failed
       $ text "conflicting patches not found in repo:"
-      $$ vcat (mapRL displayPatch (ps :<: p))
-  | not (revertedIds p `S.isSubsetOf` rids)
+      $$ vcat (mapRL showPatch (ps :<: p))
+  | not (revertedIds p `S.isSubsetOf` xids)
   = failed
-      $ text "undone patches not found in repo:"
-      $$ vcat (mapRL displayPatch (ps :<: p))
+      $ text "undone patches not a subset of conflicting patches:"
+      $$ vcat (mapRL showPatch (ps :<: p))
   | otherwise =
       case partitionRL' ((`S.member` xids) . ident) ps of
         _ :> dragged :> xs ->
@@ -109,11 +109,11 @@ prop_conflictsCommutePastConflictor ps p
             Just _ ->
               failed
                 $ text "commuting conflicts past conflictor does not result in a Prim:"
-                $$ displayPatch (ps :<: p)
+                $$ showPatch (ps :<: p)
             Nothing ->
               failed
                 $ text "cannot commute conflicts past conflictor:"
-                $$ displayPatch (ps :<: p)
+                $$ showPatch (ps :<: p)
   where
     xids = conflictIds p
     rids = idsRL ps
@@ -137,9 +137,9 @@ prop_containedCtxEq =
       | otherwise =
           failed
           $ text "prop_ctxEq: cp="
-          $$ showCtx ForStorage cp
+          $$ showCtx cp
           $$ text "cq="
-          $$ showCtx ForStorage cq
+          $$ showCtx cq
     allSucceeded = foldr (<>) succeeded
 
 idsFL :: Ident p => FL p wX wY -> S.Set (PatchId p)
diff --git a/harness/Darcs/Test/Patch/Properties/V1Set1.hs b/harness/Darcs/Test/Patch/Properties/V1Set1.hs
index 37c2454b..39f100ab 100644
--- a/harness/Darcs/Test/Patch/Properties/V1Set1.hs
+++ b/harness/Darcs/Test/Patch/Properties/V1Set1.hs
@@ -1,27 +1,18 @@
 module Darcs.Test.Patch.Properties.V1Set1
        ( checkMerge, checkMergeEquiv, checkMergeSwap, checkCanon
        , checkCommute, checkCantCommute
-       , tShowRead
        , tTestCheck ) where
 
 import Darcs.Prelude
 
-import Darcs.Patch
-     ( commute, invert, merge, effect
-     , readPatch, showPatch
-     , canonizeFL )
+import Darcs.Patch ( canonizeFL, commute, effect, invert, merge )
 import Darcs.Patch.FromPrim ( fromAnonymousPrim )
 import Darcs.Patch.Merge ( Merge )
-import Darcs.Patch.Read ( ReadPatch )
-import Darcs.Patch.Show ( ShowPatchBasic, ShowPatchFor(..) )
 import qualified Darcs.Patch.V1 as V1 ( RepoPatchV1 )
 import qualified Darcs.Patch.V1.Prim as V1 ( Prim(..) )
 import Darcs.Test.Patch.Properties.Check ( checkAPatch )
-import Darcs.Util.Printer ( renderPS )
 import Darcs.Patch.Witnesses.Eq
 import Darcs.Patch.Witnesses.Ordered
-import Darcs.Patch.Witnesses.Show
-import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed) )
 import Darcs.Patch.Witnesses.Unsafe( unsafeCoercePEnd )
 import Darcs.Test.Util.TestResult
 import qualified Darcs.Util.Diff as D (DiffAlgorithm(..))
@@ -128,14 +119,6 @@ checkCantCommute (p2 :> p1) =
 -- A few "test" properties, doing things with input patches and giving a OK/not
 -- OK type of answer.
 
-tShowRead :: (Show2 p, ReadPatch p, ShowPatchBasic p)
-          => (forall wX wY wW wZ . p wX wY -> p wW wZ -> Bool) -> forall wX wY . p wX wY -> TestResult
-tShowRead eq p =
-    case readPatch $ renderPS $ showPatch ForStorage p of
-    Right (Sealed p') -> if p' `eq` p then succeeded
-                        else failed $ text $ "Failed to read shown:  "++(show2 p)++"\n"
-    Left e -> failed $ text $ unlines ["Failed to read at all:  "++show2 p, e]
-
 tTestCheck :: forall wX wY . FL Patch wX wY -> TestResult
 tTestCheck p = if checkAPatch p
                  then succeeded
diff --git a/harness/Darcs/Test/Patch/Properties/V1Set2.hs b/harness/Darcs/Test/Patch/Properties/V1Set2.hs
index 2986f871..36ef2114 100644
--- a/harness/Darcs/Test/Patch/Properties/V1Set2.hs
+++ b/harness/Darcs/Test/Patch/Properties/V1Set2.hs
@@ -58,9 +58,11 @@ propOtherInverseValid (Sealed2 p1) = checkAPatch (p1:>:invert p1:>:NilFL)
 propCommuteTwice :: Sealed2 (FL Patch :> FL Patch) -> Property
 propCommuteTwice (Sealed2 (p1:>p2)) =
     (doesCommute p1 p2) ==> (Just (p1:>p2) == (commute (p1:>p2) >>= commute))
+
 doesCommute :: (Eq2 p, Invert p, Commute p, Check p) => p wX wY -> p wY wZ -> Bool
 doesCommute p1 p2 =
     commute (p1:>p2) /= Nothing && checkAPatch (p1:>:p2:>:NilFL)
+
 propCommuteEquivalency :: Sealed2 (FL Patch :> FL Patch) -> Property
 propCommuteEquivalency (Sealed2 (p1:>p2)) =
     (doesCommute p1 p2) ==>
@@ -110,6 +112,7 @@ propMergeIsCommutableAndCorrect (Sealed2 (p1:\/:p2)) =
         case commute (p1:>p2') of
         Nothing -> False
         Just (p2'':>p1'') -> isIsEq (p2'' =\/= p2) && isIsEq (p1' =/\= p1'')
+
 propMergeIsSwapable :: Sealed2 (FL Patch :\/: FL Patch) -> Property
 propMergeIsSwapable (Sealed2 (p1:\/:p2)) =
     checkAPatch (invert p1:>:p2:>:NilFL) ==>
diff --git a/harness/Darcs/Test/Patch/Rebase.hs b/harness/Darcs/Test/Patch/Rebase.hs
index 51fde914..427dbfc0 100644
--- a/harness/Darcs/Test/Patch/Rebase.hs
+++ b/harness/Darcs/Test/Patch/Rebase.hs
@@ -6,8 +6,8 @@ import Darcs.Prelude
 import Control.Monad ( unless )
 import Data.Maybe
 
-import Test.Framework ( Test )
-import Test.Framework.Providers.HUnit ( testCase )
+import Test.Tasty ( TestTree )
+import Test.Tasty.HUnit ( testCase )
 import Test.HUnit ( assertFailure )
 
 import Darcs.Patch
@@ -23,7 +23,7 @@ import Darcs.Test.TestOnly.Instance ()
 
 import Darcs.Util.Path ( unsafeFloatPath )
 
-testSuite :: forall p . (RepoPatch p, ArbitraryPrim (PrimOf p)) => [Test]
+testSuite :: forall p . (RepoPatch p, ArbitraryPrim (PrimOf p)) => [TestTree]
 testSuite =
     if isJust (hasPrimConstruct @(PrimOf p))
         then
@@ -35,7 +35,7 @@ testSuite =
 
 data WX
 
-duplicateConflictedEffect :: forall p . RepoPatch p => Test
+duplicateConflictedEffect :: forall p . RepoPatch p => TestTree
 duplicateConflictedEffect =
     testCase "duplicate in rebase fixup has a conflicted effect" $
         unless (all (/= Okay) cStatuses) $
diff --git a/harness/Darcs/Test/Patch/Selection.hs b/harness/Darcs/Test/Patch/Selection.hs
index 623208cf..2b8c7096 100644
--- a/harness/Darcs/Test/Patch/Selection.hs
+++ b/harness/Darcs/Test/Patch/Selection.hs
@@ -4,8 +4,8 @@ module Darcs.Test.Patch.Selection ( testSuite ) where
 
 import Darcs.Prelude
 
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.HUnit ( testCase )
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit ( testCase )
 
 import Darcs.Patch.Witnesses.Ordered ( FL(..), (:>)(..)  )
 import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
@@ -19,7 +19,7 @@ import Darcs.UI.SelectChanges
     , runSelection
     , WhichChanges(..)
     )
-import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, patchInfoAndPatch )
+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, unavailable )
 import Darcs.Patch.Info ( rawPatchInfo )
 import Darcs.UI.Options.All
     ( Verbosity(..), WithSummary(..)
@@ -31,21 +31,24 @@ import Darcs.Test.TestOnly.Instance ()
 
 type Patch = RepoPatchV2 V2.Prim
 
-testSuite :: Test
-testSuite = testGroup "Darcs.Patch.Selection" $
-  [ dontReadContents whch | whch <- [Last, LastReversed, First, FirstReversed] ]
+testSuite :: TestTree
+testSuite =
+  testGroup
+    "Darcs.Patch.Selection"
+    [ testGroup "matching on patch metadata does not open patch contents" $
+      map dontReadContents [Last, LastReversed, First, FirstReversed]
+    ]
 
-dontReadContents :: WhichChanges -> Test
+dontReadContents :: WhichChanges -> TestTree
 dontReadContents whch =
-    testCase ("Matching on patch metadata does not open patch contents: " ++ show whch)
-      $ do
+  testCase (show whch) $ do
    let -- here is an FL of patches whose metadata can be read but whose contents
        -- should NEVER be read, otherwise something really bad would happen.
        launchNuclearMissilesPatches = unsafeCoerceP $ lnmPatches [ "P " ++ show i | i <- [1..5::Int] ]
        lnmPatches [] = NilFL
        lnmPatches (n:names) = buildPatch n  :>: lnmPatches names
        buildPatch :: String -> PatchInfoAnd Patch wX wY
-       buildPatch name = patchInfoAndPatch (rawPatchInfo "1999" name "harness" [] False) (error "Patch content read!")
+       buildPatch name = unavailable (rawPatchInfo "1999" name "harness" [] False) "Patch content read!"
        pso = PatchSelectionOptions
            { verbosity = Quiet
            , matchFlags = [OnePatch "."]  -- match on every patch
@@ -59,4 +62,3 @@ dontReadContents whch =
    -- and unselected are NilFL or not) should not evaluate the `undefined` inside of our
    -- patches, ie, we don't need to read too much.
    unselected `seq` selected `seq` return ()
-
diff --git a/harness/Darcs/Test/Patch/Types/MergeableSequence.hs b/harness/Darcs/Test/Patch/Types/MergeableSequence.hs
index ff720bfa..3453b04a 100644
--- a/harness/Darcs/Test/Patch/Types/MergeableSequence.hs
+++ b/harness/Darcs/Test/Patch/Types/MergeableSequence.hs
@@ -75,64 +75,73 @@ instance
   -- Note that the result of propagateShrink is always either
   -- Just (Just2 _ :> _) or Nothing, so we don't need to worry about
   -- the Just (Nothing2 :> _) case in recursive calls.
-  propagateShrink (prim :> NilMS) = Just (Just2 NilMS :> Just2 prim)
+  propagateShrink (prim :> NilMS) = return (Just2 NilMS :> prim :>: NilFL)
   propagateShrink (prim :> SeqMS ps p) = do
-    Just2 ps' :> mprim' <- propagateShrink (prim :> ps)
-    mp' :> mprim'' <- propagateShrinkMaybe (mprim' :> p)
+    Just2 ps' :> prims' <- propagateShrink (prim :> ps)
+    mp' :> prims'' <- propagateShrinks (prims' :> p)
     let result = case mp' of
           Just2 p' -> SeqMS ps' p'
           Nothing2 -> ps'
-    return (Just2 result :> mprim'')
+    return (Just2 result :> prims'')
+{-
+  As usual, a picture makes it crystal clear what's going on.
+
+  Inputs: prim, ParMS ms1 ms2
+  Intermediate results from recursive calls: ms1', prims1', ms2', prims2'
+  Outputs: parMS ms1' ms2' :> prims'
+
+     Merged C1 C2 ---prims'---> Merged D1 D2
+            / \                  / \
+   mergedps2' mergedps1' mergedps2  mergedps1
+          /     \              /     \
+         /      C2 --prims2'--/-----> D2
+        /       /            /       /
+      C1 --------prims1'--> D1      /
+        \     /              \     /
+       ms1'  ms2'           ms1   ms2
+          \ /                  \ /
+           A -------prim------> B
+
+-}
   propagateShrink
     ((prim :: prim wA wB) :>
        ParMS (ms1 :: MergeableSequence p wB wD1) (ms2 :: MergeableSequence p wB wD2)) = do
-    Just2 (ms1' :: MergeableSequence p wA wC1) :> (mprim1' :: Maybe2 prim wC1 wD1)
+    Just2 (ms1' :: MergeableSequence p wA wC1) :> (prims1' :: FL prim wC1 wD1)
       <- propagateShrink (prim :> ms1)
-    Just2 (ms2' :: MergeableSequence p wA wC2) :> (mprim2' :: Maybe2 prim wC2 wD2)
+    Just2 (ms2' :: MergeableSequence p wA wC2) :> (_prims2' :: FL prim wC2 wD2)
       <- propagateShrink (prim :> ms2)
     let
       ms' :: MergeableSequence p wA (Merged wC1 wC2)
       ms' = parMS ms1' ms2'
       ps1  :: FL p wB wD1
       ps2  :: FL p wB wD2
-      mergedps1 :: FL p wD2 (Merged wD1 wD2)
+      _mergedps1 :: FL p wD2 (Merged wD1 wD2)
       mergedps2 :: FL p wD1 (Merged wD1 wD2)
       ps1' :: FL p wA wC1
       ps2' :: FL p wA wC2
-      mergedps1' :: FL p wC2 (Merged wC1 wC2)
+      _mergedps1' :: FL p wC2 (Merged wC1 wC2)
       mergedps2' :: FL p wC1 (Merged wC1 wC2)
       ps1  = reverseRL (mergeableSequenceToRL ms1)
       ps2  = reverseRL (mergeableSequenceToRL ms2)
       ps1' = reverseRL (mergeableSequenceToRL ms1')
       ps2' = reverseRL (mergeableSequenceToRL ms2')
-      (mergedps2 , mergedps1 ) = typedMerge (ps1  :\/: ps2 )
-      (mergedps2', mergedps1') = typedMerge (ps1' :\/: ps2')
-      -- Unless the shrinking prim disappears on both branches of the merge,
-      -- we'll need to try to recalculate it for the result of the merge - trying
-      -- to use propagateShrink a second time wouldn't guarantee the right
-      -- contexts. (This is a bit complicated to see, hence all the type signatures
-      -- in this function.)
+      (mergedps2 , _mergedps1 ) = typedMerge (ps1  :\/: ps2 )
+      (mergedps2', _mergedps1') = typedMerge (ps1' :\/: ps2')
+      prims' :: FL prim (Merged wC1 wC2) (Merged wD1 wD2)
+      -- Arbitrarily choose one of two ways of constructing the result;
+      -- we could as well use
+      -- > prims' = recalcShrink prims2' mergedps1 mergedps1'
+      -- In fact, coalescing of effects should make them equal.
+      -- Also note that if both prims1' and prims2' are NilFL, then
+      -- the result should be NilFL as well, since in that case
+      -- mergedps2 and mergedps2' are parallel.
+      prims' = recalcShrink prims1' mergedps2 mergedps2'
+    return (Just2 ms' :> prims')
+    where
       recalcShrink
-        :: prim wX wY
-        -> FL p wY (Merged wD1 wD2)
-        -> FL p wX (Merged wC1 wC2)
-        -> Maybe (Maybe2 prim (Merged wC1 wC2) (Merged wD1 wD2))
-      recalcShrink primIn m1 m2 =
-        case sortCoalesceFL (invert (effect m2) +>+ primIn :>: effect m1) of
-          NilFL -> Just Nothing2
-          prim' :>: NilFL -> Just (Just2 prim')
-          -- If we don't get 0 or 1 prims, we can't use this result given the type
-          -- of propagateShrink as a whole. If that was changed to return an FL we
-          -- could use it, but at the cost of more complexity elsewhere.
-          _ -> Nothing
-    mprim' :: Maybe2 prim (Merged wC1 wC2) (Merged wD1 wD2)
-      <-
-      case (mprim1', mprim2') of
-        (Nothing2, Nothing2) -> Just Nothing2
-        (Just2 prim1', _) | Just prim'' <- recalcShrink prim1' mergedps2 mergedps2' -> Just prim''
-        (_, Just2 prim2') | Just prim'' <- recalcShrink prim2' mergedps1 mergedps1' -> Just prim''
-        _ -> Nothing
-    return (Just2 ms' :> mprim')
+        :: FL prim wX wY -> FL p wY wD -> FL p wX wC -> FL prim wC wD
+      recalcShrink prims ps qs =
+        sortCoalesceFL $ invert (effect qs) +>+ prims +>+ effect ps
 
 instance (Show2 p, PrimBased p) => Show (MergeableSequence p wX wY) where
   showsPrec _d NilMS = showString "NilMS"
diff --git a/harness/Darcs/Test/Patch/Types/Merged.hs b/harness/Darcs/Test/Patch/Types/Merged.hs
index b5976d12..291e9aeb 100644
--- a/harness/Darcs/Test/Patch/Types/Merged.hs
+++ b/harness/Darcs/Test/Patch/Types/Merged.hs
@@ -8,15 +8,39 @@ import Darcs.Patch.Witnesses.Unsafe
 import Darcs.Patch.Witnesses.Ordered
 import Darcs.Patch.Merge ( Merge(..), mergerFLFL )
 
--- | A witness type that makes the result witness of merging explicit:
---
---  wB    ----> Merged wA wB
---   ^           ^
---   |           |
---   |           |
---  wBase ----> wA
---
--- It's quite ad hoc, for example we don't define a type for 'wBase'.
+{- | A witness type that makes the result witness of merging explicit:
+
+>  wA -----> wY = Merged wA wB
+>   ^        ^
+>   |        |
+>   |        |
+>   |        |
+>  wX -----> wB
+
+It's quite ad hoc. Even if we add @wX@ as a third parameter, as in
+
+> typedMerge :: p wX wA -> p wX wB -> (p wA (Merged wA wX wB), p wB (Merged wA wX wB))
+
+this breaks down as soon as we try to exploit symmetries. For instance, the
+symmetry of merge requires that
+
+> Merged wA wX wB ~ Merged wB wX wA
+
+and, given something like
+
+> typedCommute :: p wX wA -> p wA wY -> (p wX wB, p wB wY)
+
+the merge-commute law would require
+
+> wB ~ Merged wY wA wX ~ Merged (Merged wB wX wA) wA wX
+
+etc. In fact, we want equalities corresponding to all 8 symmetries of a
+square (the group D4 with 4 rotations and 4 reflections).
+
+The problem here seems to be that we use '*' (aka 'Type') for witnesses.
+With a dedicated witness kind we could define our own equality rules and
+hope that we can convince the type checker to make use of them. -}
+
 data Merged wA wB
 
 -- | A wrapper around 'merge' for FL that checks each individual merge,
@@ -28,4 +52,3 @@ typedMerge
 typedMerge (p :\/: q) =
   case mergerFLFL (checkedMerger merge) (p :\/: q) of
     (q' :/\: p') -> (unsafeCoercePEnd q', unsafeCoercePEnd p')
-
diff --git a/harness/Darcs/Test/Patch/Unwind.hs b/harness/Darcs/Test/Patch/Unwind.hs
index 679d61d4..c05bce61 100644
--- a/harness/Darcs/Test/Patch/Unwind.hs
+++ b/harness/Darcs/Test/Patch/Unwind.hs
@@ -19,9 +19,9 @@ import Darcs.Test.Patch.RepoModel
 import Darcs.Test.Patch.WithState
 import Darcs.Test.Util.TestResult ( TestResult, succeeded, assertNotFailed )
 
-import Test.Framework ( Test )
-import Test.Framework.Providers.HUnit ( testCase )
-import Test.Framework.Providers.QuickCheck2 ( testProperty )
+import Test.Tasty ( TestTree, adjustOption )
+import Test.Tasty.HUnit ( testCase )
+import Test.Tasty.QuickCheck ( QuickCheckMaxSize(..), testProperty )
 
 -- This property could be generalised over all instances of Unwind (not
 -- just Named), but in practice it is only interesting for Named, for which
@@ -35,10 +35,10 @@ propUnwindNamedSucceeds p =
     Unwound before ps after ->
       lengthFL before `seq` ps `seq` lengthRL after `seq` succeeded
 
-numberedTestCases :: forall a . String -> (a -> TestResult) -> [a] -> [Test]
+numberedTestCases :: forall a . String -> (a -> TestResult) -> [a] -> [TestTree]
 numberedTestCases text runTest = zipWith numbered [1..]
   where
-    numbered :: Int -> a -> Test
+    numbered :: Int -> a -> TestTree
     numbered n testItem = testCase (text ++ " " ++ show n) (assertNotFailed $ runTest testItem)
 
 testSuite
@@ -51,17 +51,17 @@ testSuite
      , PrimBased p
      , ArbitraryPrim (OnlyPrim p)
      , ShrinkModel (ModelOf p) (PrimOf p)
-     , Show1 (ModelOf p)
      , Show2 p
      , CheckedMerge p
      , Commute (OnlyPrim p)
      , RepoApply (PrimOf p)
      )
-  => [Test]
+  => [TestTree]
 testSuite =
     -- TODO these need to take the patch type, currently hard-coded to V1
     numberedTestCases "full unwind example" (withAllSequenceItems propUnwindNamedSucceeds) (examples @p)
       ++
-  [ testProperty "unwind named succeeds"
+  [ adjustOption (\(QuickCheckMaxSize n) -> QuickCheckMaxSize (n `div` 5)) $
+    testProperty "unwind named succeeds"
      (withAllSequenceItems (propUnwindNamedSucceeds :: PatchProperty (Named p)))
   ]
diff --git a/harness/Darcs/Test/Patch/Utils.hs b/harness/Darcs/Test/Patch/Utils.hs
index 12f4f5b4..c12ba85d 100644
--- a/harness/Darcs/Test/Patch/Utils.hs
+++ b/harness/Darcs/Test/Patch/Utils.hs
@@ -14,9 +14,9 @@ import Darcs.Prelude
 
 import Data.Maybe ( fromMaybe )
 
-import Test.Framework ( Test, TestName )
-import Test.Framework.Providers.HUnit ( testCase )
-import Test.Framework.Providers.QuickCheck2 ( testProperty )
+import Test.Tasty ( TestTree, TestName )
+import Test.Tasty.HUnit ( testCase )
+import Test.Tasty.QuickCheck ( testProperty )
 import Test.HUnit ( assertFailure )
 import Test.QuickCheck ( Arbitrary, Testable, (==>) )
 
@@ -28,7 +28,7 @@ testConditional
   :: (Arbitrary a, Show a, Testable prop) => TestName     -- ^ Test name
                                           -> (a -> Bool)  -- ^ Condition
                                           -> (a -> prop)  -- ^ Test function
-                                          -> Test
+                                          -> TestTree
 testConditional name cond t = testProperty name t'
     where t' x = cond x ==> t x
 
@@ -37,7 +37,7 @@ testConditionalMaybe
   => TestName -- ^ Test name
   -> (a -> Maybe Bool) -- ^ Condition
   -> (a -> prop) -- ^ Test function
-  -> Test
+  -> TestTree
 testConditionalMaybe name cond t = testProperty name t'
   where
     cond' x =
@@ -48,7 +48,7 @@ testConditionalMaybe name cond t = testProperty name t'
 
 -- | Utility function to run old tests that return a list of error messages,
 --   with the empty list meaning success.
-testStringList :: String -> [String] -> Test
+testStringList :: String -> [String] -> TestTree
 testStringList name test = testCase name $ mapM_ assertFailure test
 
 -- | Run a test function on a set of data, using HUnit. The test function should
@@ -56,7 +56,7 @@ testStringList name test = testCase name $ mapM_ assertFailure test
 testCases :: String             -- ^ The test name
           -> (a -> TestResult)  -- ^ The test function
           -> [a]                -- ^ The test data
-          -> Test
+          -> TestTree
 testCases name test datas = testCase name (mapM_ (assertNotFailed . test) datas)
 
 newtype TestGenerator thing gen =
@@ -68,13 +68,13 @@ newtype TestCondition thing =
 newtype TestCheck thing t =
   TestCheck (forall wX wY. thing wX wY -> t)
 
-type PropList what gen = String -> TestGenerator what gen -> [Test]
+type PropList what gen = String -> TestGenerator what gen -> [TestTree]
 
 properties :: forall thing gen. (Show gen, Arbitrary gen)
            => TestGenerator thing gen
            -> String -> String
            -> forall t. (Testable t) => [(String, TestCondition thing, TestCheck thing t)]
-           -> [Test]
+           -> [TestTree]
 properties (TestGenerator gen) prefix genname tests =
   [cond name condition check | (name, condition, check) <- tests]
   where
@@ -83,7 +83,7 @@ properties (TestGenerator gen) prefix genname tests =
       => String
       -> TestCondition thing
       -> TestCheck thing testable
-      -> Test
+      -> TestTree
     cond t (TestCondition c) (TestCheck p) =
       testConditional
         (prefix ++ " (" ++ genname ++ "): " ++ t)
diff --git a/harness/Darcs/Test/Patch/WithState.hs b/harness/Darcs/Test/Patch/WithState.hs
index abe37527..e6542daa 100644
--- a/harness/Darcs/Test/Patch/WithState.hs
+++ b/harness/Darcs/Test/Patch/WithState.hs
@@ -243,28 +243,34 @@ class PropagateShrink prim p where
   -- Given a test patch (of type @p@) and a shrinking fixup (of type @prim@),
   -- try to propagate the shrinking fixup past the test patch.
   -- The @Maybe2 p@ return type allows the fixup to eliminate the shrinking
-  -- patch entirely, and vice versa the @Maybe2 prim@ allows the shrinking fixup
+  -- patch entirely, and vice versa the @FL prim@ allows the shrinking fixup
   -- to disappear (for example it might be cancelled out by something in the test
   -- patch).
-  -- We don't use @FL p@, because that would only really be useful for a "stuck"
-  -- fixup - one that doesn't eliminate or commute - and that implies that
-  -- the state shrink isn't actually shrinking the real test case.
-  propagateShrink :: (prim :> p) wX wY -> Maybe ((Maybe2 p :> Maybe2 prim) wX wY)
+  -- In the result type we use @FL prim@ for the propagated shrinking fixups
+  -- (instead of the more restrictive @Maybe2 prim@) because for
+  -- MergeableSequence this makes propagateShrink succeed in more cases.
+  propagateShrink :: (prim :> p) wX wY -> Maybe ((Maybe2 p :> FL prim) wX wY)
 
 propagateShrinkKeep
   :: PropagateShrink prim p
   => (prim :> p) wX wY
-  -> Maybe ((p :> Maybe2 prim) wX wY)
+  -> Maybe ((p :> FL prim) wX wY)
 propagateShrinkKeep inp = do
-  Just2 p' :> mprim' <- propagateShrink inp
-  return (p' :> mprim')
+  Just2 p' :> prims' <- propagateShrink inp
+  return (p' :> prims')
 
-propagateShrinkMaybe
+propagateShrinks
   :: PropagateShrink prim p
-  => (Maybe2 prim :> p) wX wY
-  -> Maybe ((Maybe2 p :> Maybe2 prim) wX wY)
-propagateShrinkMaybe (Nothing2 :> p) = Just (Just2 p :> Nothing2)
-propagateShrinkMaybe (Just2 prim :> p) = propagateShrink (prim :> p)
+  => (FL prim :> p) wX wY
+  -> Maybe ((Maybe2 p :> FL prim) wX wY)
+propagateShrinks (NilFL :> p) = Just (Just2 p :> NilFL)
+propagateShrinks (prim :>: prims :> p) = do
+  mp' :> prims' <- propagateShrinks (prims :> p)
+  case mp' of
+    Nothing2 -> return (Nothing2 :> prim :>: prims')
+    Just2 p' -> do
+      mp'' :> prims'' <- propagateShrink (prim :> p')
+      return (mp'' :> prims'' +>+ prims')
 
 -- |Shrink a test case wrapped with 'WithStartState2' by shrinking the start state
 -- of the test case with 'ShrinkModel' and then propagating the shrink through the
@@ -318,28 +324,35 @@ instance
     shrinkState @s @prim @p w
 
 propagatePrim
-  :: (Eq2 prim, PrimCoalesce prim, Invert prim, Commute prim)
-  => (prim :> prim) wX wY -> Maybe ((Maybe2 prim :> Maybe2 prim) wX wY)
+  :: PrimCoalesce prim
+  => (prim :> prim) wX wY -> Maybe ((Maybe2 prim :> FL prim) wX wY)
 propagatePrim (p1 :> p2)
-  | IsEq <- invert p1 =\/= p2 = Just (Nothing2 :> Nothing2)
-  | Just (p2' :> p1') <- commute (p1 :> p2) = Just (Just2 p2' :> Just2 p1')
-  | Just p' <- primCoalesce p1 p2 = Just (Just2 p' :> Nothing2)
+  -- The order of guards here means we prefer commutation over coalescing. In
+  -- most cases coalescing prims don't commute and, vice versa, commuting prims
+  -- don't coalesce, so it makes no difference. I think for Prim.V1 the only
+  -- exception is adjacent hunks that both add and remove lines. In this case,
+  -- commutation simplifies more, so the choice here is justified.
+  | IsEq <- invert p1 =\/= p2 = Just (Nothing2 :> NilFL)
+  | Just (p2' :> p1') <- commute (p1 :> p2) = Just (Just2 p2' :> p1' :>: NilFL)
+  | Just p' <- primCoalesce p1 p2 = Just (Just2 p' :> NilFL)
   | otherwise = Nothing
 
 instance (PropagateShrink prim p, PropagateShrink prim q)
   => PropagateShrink prim (p :> q) where
 
   propagateShrink (prim :> (p :> q)) = do
-    Just2 mp' :> mprim' <- propagateShrink (prim :> p)
-    Just2 mq' :> mprim'' <- propagateShrinkMaybe (mprim' :> q)
-    return (Just2 (mp' :> mq') :> mprim'')
+    Just2 mp' :> prims' <- propagateShrink (prim :> p)
+    Just2 mq' :> prims'' <- propagateShrinks (prims' :> q)
+    return (Just2 (mp' :> mq') :> prims'')
 
 instance PropagateShrink prim p => PropagateShrink prim (FL p) where
-  propagateShrink (prim :> NilFL) = Just (Just2 NilFL :> Just2 prim)
+  propagateShrink (prim :> NilFL) = return (Just2 NilFL :> prim :>: NilFL)
   propagateShrink (prim :> (p :>: ps)) = do
-    mp' :> mprim' <- propagateShrink (prim :> p)
-    Just2 ps' :> mprim'' <- propagateShrinkMaybe (mprim' :> ps)
-    let result = case mp' of
-          Nothing2 -> ps'
-          Just2 p' -> p' :>: ps'
-    return (Just2 result :> mprim'')
+    mp' :> prims' <- propagateShrink (prim :> p)
+    mps' :> prims'' <- propagateShrinks (prims' :> ps)
+    let result = case (mp', mps') of
+          (Nothing2, Nothing2) -> NilFL
+          (Nothing2, Just2 ps') -> ps'
+          (Just2 p', Nothing2) -> p' :>: NilFL
+          (Just2 p', Just2 ps') -> p' :>: ps'
+    return (Just2 result :> prims'')
diff --git a/harness/Darcs/Test/Repository/Inventory.hs b/harness/Darcs/Test/Repository/Inventory.hs
index 127e535b..0fd4a9de 100644
--- a/harness/Darcs/Test/Repository/Inventory.hs
+++ b/harness/Darcs/Test/Repository/Inventory.hs
@@ -11,39 +11,43 @@ import Darcs.Repository.Inventory
     , PatchHash
     , PristineHash
     , parseInventory
-    , showInventory
+    , formatInventory
     , skipPristineHash
     , peekPristineHash
     , pokePristineHash
-    , prop_inventoryParseShow
+    , prop_inventoryParseFormat
     , prop_peekPokePristineHash
     , prop_skipPokePristineHash
     )
 import Darcs.Patch.Info ( rawPatchInfo )
-import Darcs.Util.Hash ( sha256strict )
-import Darcs.Util.Printer ( renderPS )
+import Darcs.Util.Hash ( sha256 )
+import Darcs.Util.Format ( toStrictByteString )
 import Darcs.Util.ValidHash ( decodeValidHash, fromHash, fromSizeAndHash )
 
 import Darcs.Test.Patch.Info ()
 
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as BL
 import Data.Maybe ( fromJust )
-import Test.Framework ( Test, testGroup )
-import Test.Framework.Providers.HUnit ( testCase )
-import Test.Framework.Providers.QuickCheck2 ( testProperty )
 import Test.HUnit ( Assertion, (@=?) )
 import Test.QuickCheck
 import Test.QuickCheck.Instances.ByteString ()
+import Test.Tasty ( TestTree, adjustOption, testGroup )
+import Test.Tasty.HUnit ( testCase )
+import Test.Tasty.QuickCheck ( QuickCheckMaxSize(..), testProperty )
 
-testSuite :: Test
+halveSize :: TestTree -> TestTree
+halveSize = adjustOption (\(QuickCheckMaxSize n) -> QuickCheckMaxSize (n `div` 2))
+
+testSuite :: TestTree
 testSuite = testGroup "Darcs.Repository.Inventory"
- [ testProperty "parse/show roundtrips" prop_inventoryParseShow
- , testProperty "peek gets back what we poked" prop_peekPokePristineHash
- , testProperty "skip/poke roundtrips" prop_skipPokePristineHash
- , testCase "example1" (testInventory rawHeadInv1 headInv1)
- , testCase "example2" (testInventory rawHeadInv2 headInv2)
- ]
+  [ halveSize $ testProperty "parse/format roundtrips" prop_inventoryParseFormat
+  , testProperty "peek gets back what we poked" prop_peekPokePristineHash
+  , testProperty "skip/poke roundtrips" prop_skipPokePristineHash
+  , testCase "example1" (testInventory rawHeadInv1 headInv1)
+  , testCase "example2" (testInventory rawHeadInv2 headInv2)
+  ]
 
 instance Arbitrary Inventory where
   arbitrary = uncurry Inventory <$> arbitrary
@@ -59,8 +63,8 @@ arbitraryHash :: ValidHash h => Gen h
 arbitraryHash = do
   content       <- arbitrary
   size_prefixed <- arbitrary
-  let size = B.length content
-      hash = sha256strict content
+  let size = BL.length content
+      hash = sha256 content
   if size_prefixed && size < 1000000000
     then return (fromSizeAndHash size hash)
     else return (fromHash hash)
@@ -70,8 +74,8 @@ testInventory raw (hash,inv) = do
   hash @=? peekPristineHash raw
   let rest = skipPristineHash raw
   Right inv @=? parseInventory rest
-  rest @=? renderPS (showInventory inv)
-  raw @=? renderPS (pokePristineHash hash rest)
+  rest @=? toStrictByteString (formatInventory inv)
+  raw @=? toStrictByteString (pokePristineHash hash rest)
 
 mkValidHash :: ValidHash a => String -> a
 mkValidHash = fromJust . decodeValidHash
diff --git a/harness/Darcs/Test/Shell.hs b/harness/Darcs/Test/Shell.hs
index 32346134..61379756 100644
--- a/harness/Darcs/Test/Shell.hs
+++ b/harness/Darcs/Test/Shell.hs
@@ -5,15 +5,17 @@ module Darcs.Test.Shell
     , DiffAlgorithm(..)
     , UseIndex(..)
     , UseCache(..)
-    , findShell
+    , genShellTests
     ) where
 
 import Darcs.Prelude
 
 import Control.Exception ( SomeException )
-import Data.Data ( Data, Typeable )
+import Data.List ( intercalate )
+import Data.Tagged ( Tagged(..) )
 import Data.Text ( Text, pack, unpack )
 import qualified Data.Text as T
+import Data.Typeable ( Typeable )
 import qualified Shelly ( FilePath, run )
 import Shelly
     ( Sh
@@ -41,19 +43,20 @@ import qualified System.FilePath as Native ( splitSearchPath )
 import System.FilePath ( makeRelative, takeBaseName, takeDirectory )
 import qualified System.FilePath.Posix as Posix ( searchPathSeparator )
 import System.IO ( hSetBinaryMode )
-import Test.Framework.Providers.API
-    ( Test(..)
-    , TestResultlike(..)
-    , Testlike(..)
-    , liftIO
-    , runImprovingIO
-    , yieldImprovement
+import Test.Tasty.Options ( IsOption(..) )
+import Test.Tasty ( testGroup )
+import Test.Tasty.Providers
+    ( IsTest(..)
+    , TestTree
+    , singleTest
+    , testFailed
+    , testPassed
     )
 
-data Format = Darcs1 | Darcs2 | Darcs3 deriving (Show, Eq, Typeable, Data)
-data DiffAlgorithm = Myers | Patience deriving (Show, Eq, Typeable, Data)
-data UseIndex = NoIndex | WithIndex deriving (Show, Eq, Typeable, Data)
-data UseCache = NoCache | WithCache deriving (Show, Eq, Typeable, Data)
+data Format = Darcs1 | Darcs2 | Darcs3 deriving (Show, Eq, Typeable)
+data DiffAlgorithm = Myers | Patience deriving (Show, Eq, Typeable)
+data UseIndex = NoIndex | WithIndex deriving (Show, Eq, Typeable)
+data UseCache = NoCache | WithCache deriving (Show, Eq, Typeable)
 
 data ShellTest = ShellTest
   { format :: Format
@@ -69,22 +72,20 @@ data ShellTest = ShellTest
 data Running = Running deriving Show
 data Result = Success | Skipped | Failed String
 
-instance Show Result where
-  show Success = "Success"
-  show Skipped = "Skipped"
-  show (Failed f) = unlines (map ("| " ++) $ lines f)
+newtype TestDir = TestDir (Maybe FilePath)
+instance IsOption TestDir where
+  defaultValue = TestDir Nothing
+  parseValue s = Just (TestDir (Just s))
+  optionName = Tagged "d"
+  optionHelp = Tagged "Directory to run tests in"
 
-instance TestResultlike Running Result where
-  testSucceeded Success = True
-  testSucceeded Skipped = True
-  testSucceeded _ = False
-
-instance Testlike Running Result ShellTest where
-  testTypeName _ = "Shell"
-  runTest _ test =
-    runImprovingIO $ do
-      yieldImprovement Running
-      liftIO (shelly $ runtest test)
+instance IsTest ShellTest where
+  testOptions = Tagged []
+  run _opts test _progress = resultToTasty <$> shelly (runtest test)
+    where
+      resultToTasty Success = testPassed ""
+      resultToTasty Skipped = testPassed "Skipped"
+      resultToTasty (Failed msg) = testFailed msg
 
 -- | Environment variable values may need translating depending on whether we
 -- are setting them directly or writing out a shell script to set them, and
@@ -228,7 +229,7 @@ runtest test@ShellTest{..} =
             job d
         Nothing -> withTmpDir
 
-findShell
+genShellTests
   :: FilePath
   -> [FilePath]
   -> Maybe FilePath
@@ -237,44 +238,28 @@ findShell
   -> [Format]
   -> [UseIndex]
   -> [UseCache]
-  -> IO [Test]
-findShell dp files tdir ghcflags diffAlgorithms repoFormats useindexs usecaches =
-  do
-    return
-      [ shellTest
-          ShellTest
-            { format = fmt
-            , testfile = file
-            , testdir = tdir
-            , darcspath = dp
-            , ghcflags = ghcflags
-            , diffalgorithm = da
-            , useindex = ui
-            , usecache = uc
-            }
-      | file <- files
-      , fmt <- repoFormats
-      , da <- diffAlgorithms
-      , ui <- useindexs
-      , uc <- usecaches
-      ]
-
-shellTest :: ShellTest -> Test
-shellTest test@ShellTest{..} = Test name test
-  where
-    name =
-      concat
-        [ unpack (toTextIgnore (takeTestName testfile))
-        , " ("
-        , show format
-        , ","
-        , show diffalgorithm
-        , ","
-        , show useindex
-        , ","
-        , show usecache
-        , ")"
-        ]
+  -> [TestTree]
+genShellTests dp files tdir ghcflags diffAlgorithms repoFormats useindexs usecaches =
+  [ testGroup file
+    [ singleTest variant
+      ShellTest
+        { format = fmt
+        , testfile = file
+        , testdir = tdir
+        , darcspath = dp
+        , ghcflags = ghcflags
+        , diffalgorithm = da
+        , useindex = ui
+        , usecache = uc
+        }
+    | fmt <- repoFormats
+    , da <- diffAlgorithms
+    , ui <- useindexs
+    , uc <- usecaches
+    , let variant = intercalate "," [show fmt, show da, show ui, show uc]
+    ]
+  | file <- files
+  ]
 
 takeTestName :: FilePath -> Shelly.FilePath
 takeTestName n =
diff --git a/harness/Darcs/Test/UI.hs b/harness/Darcs/Test/UI.hs
index f164e04f..464da028 100644
--- a/harness/Darcs/Test/UI.hs
+++ b/harness/Darcs/Test/UI.hs
@@ -3,9 +3,9 @@ module Darcs.Test.UI ( testSuite ) where
 import qualified Darcs.Test.UI.Commands.Test ( testSuite )
 import qualified Darcs.Test.UI.Commands.Convert.Export ( testSuite )
 
-import Test.Framework ( Test, testGroup )
+import Test.Tasty ( TestTree, testGroup )
 
-testSuite :: Test
+testSuite :: TestTree
 testSuite =
   testGroup "Darcs.UI"
     [ Darcs.Test.UI.Commands.Test.testSuite
diff --git a/harness/Darcs/Test/UI/Commands/Convert/Export.hs b/harness/Darcs/Test/UI/Commands/Convert/Export.hs
index f728f74f..89251773 100644
--- a/harness/Darcs/Test/UI/Commands/Convert/Export.hs
+++ b/harness/Darcs/Test/UI/Commands/Convert/Export.hs
@@ -3,11 +3,11 @@ module Darcs.Test.UI.Commands.Convert.Export ( testSuite ) where
 import Darcs.Prelude
 import Darcs.UI.Commands.Convert.Export ( cleanPatchAuthor, cleanPatchAuthorTestCases )
 
-import Test.Framework.Providers.HUnit ( testCase )
-import Test.Framework ( Test, testGroup )
+import Test.Tasty.HUnit ( testCase )
+import Test.Tasty ( TestTree, testGroup )
 import Test.HUnit ( (@?=) )
 
-testSuite :: Test
+testSuite :: TestTree
 testSuite = testGroup "Darcs.UI.Commands.Convert.Export"
   [ testGroup "cleanPatchAuthor" $ flip map cleanPatchAuthorTestCases $ \(input, expected) ->
       testCase (show input) $ cleanPatchAuthor input @?= expected
diff --git a/harness/Darcs/Test/UI/Commands/Test.hs b/harness/Darcs/Test/UI/Commands/Test.hs
index 0b688d3c..afbca1c1 100644
--- a/harness/Darcs/Test/UI/Commands/Test.hs
+++ b/harness/Darcs/Test/UI/Commands/Test.hs
@@ -3,9 +3,9 @@ module Darcs.Test.UI.Commands.Test ( testSuite ) where
 import qualified Darcs.Test.UI.Commands.Test.Commutable ( testSuite )
 import qualified Darcs.Test.UI.Commands.Test.Simple ( testSuite )
 
-import Test.Framework ( Test, testGroup )
+import Test.Tasty ( TestTree, testGroup )
 
-testSuite :: Test
+testSuite :: TestTree
 testSuite =
   testGroup "Darcs.UI.Commands.Test"
     [ Darcs.Test.UI.Commands.Test.Simple.testSuite
diff --git a/harness/Darcs/Test/UI/Commands/Test/Commutable.hs b/harness/Darcs/Test/UI/Commands/Test/Commutable.hs
index e39684fb..80cb1de8 100644
--- a/harness/Darcs/Test/UI/Commands/Test/Commutable.hs
+++ b/harness/Darcs/Test/UI/Commands/Test/Commutable.hs
@@ -22,18 +22,18 @@ import qualified Darcs.UI.Options.All as O
 
 import Darcs.Test.UI.Commands.Test.IndexedApply ( IndexedApply(..) )
 
-import Test.Framework ( Test, testGroup )
-import Test.Framework.Providers.HUnit ( testCase )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( testCase )
 import Test.HUnit ( assertEqual )
 
-testSuite :: Test
+testSuite :: TestTree
 testSuite =
   testGroup "Darcs.UI.Commands.Test.Commutable"
     [ testGroup "Generic test cases" $ map genericTestCases [O.Linear, O.Bisect, O.Backoff]
     ]
 
 
-genericTestCases :: O.TestStrategy -> Test
+genericTestCases :: O.TestStrategy -> TestTree
 genericTestCases testStrategy =
   testGroup (show testStrategy) $ map (expectedResult testStrategy)
     [ ("Unminimisable sequence",
@@ -107,7 +107,7 @@ type ExpectedResult =
   , StrategyResultRaw [Int]
   )
 
-expectedResult :: O.TestStrategy -> (String, ExpectedResult) -> Test
+expectedResult :: O.TestStrategy -> (String, ExpectedResult) -> TestTree
 expectedResult testStrategy (testName, (testDetails, expectedNoShrinkingResult, expectedShrinkingResult)) =
   testCase testName $ do
     let
diff --git a/harness/Darcs/Test/UI/Commands/Test/Simple.hs b/harness/Darcs/Test/UI/Commands/Test/Simple.hs
index 36feacce..df7a040f 100644
--- a/harness/Darcs/Test/UI/Commands/Test/Simple.hs
+++ b/harness/Darcs/Test/UI/Commands/Test/Simple.hs
@@ -24,14 +24,14 @@ import Darcs.UI.Commands.Test.Impl
 import Darcs.Test.UI.Commands.Test.IndexedApply ( IndexedApply(..) )
 
 import Data.Constraint ( Dict(..) )
-import Test.Framework.Providers.HUnit ( testCase )
-import Test.Framework.Providers.QuickCheck2 ( testProperty )
-import Test.Framework ( Test, testGroup )
+import Test.Tasty.HUnit ( testCase )
+import Test.Tasty.QuickCheck ( QuickCheckMaxSize(..), testProperty )
+import Test.Tasty ( TestTree, adjustOption, testGroup )
 import Test.HUnit ( assertEqual )
 import Test.QuickCheck ( Arbitrary(..), Gen, Property, property, Discard(..), forAll, forAllShrink )
 import Test.QuickCheck.Gen ( listOf, listOf1, frequency, elements )
 
-testSuite :: Test
+testSuite :: TestTree
 testSuite =
   testGroup "Darcs.UI.Commands.Test.Simple"
     [ testGroup "Generic test cases" $ map genericTestCases [O.Linear, O.Bisect, O.Backoff]
@@ -39,7 +39,7 @@ testSuite =
     , testGroup "Randomised tests against linear" $ map genericRandomised [O.Bisect, O.Backoff]
     ]
 
-genericTestCases :: O.TestStrategy -> Test
+genericTestCases :: O.TestStrategy -> TestTree
 genericTestCases testStrategy =
   testGroup (show testStrategy) $ map (expectedResult testStrategy)
     [ ("Sequence ending in success", ((U, [S]), NoFailureOnHead))
@@ -53,21 +53,22 @@ genericTestCases testStrategy =
 
 type ExpectedResult = ((TestingState, [TestingState]), StrategyResultRaw [Int])
 
-expectedResult :: O.TestStrategy -> (String, ExpectedResult) -> Test
+expectedResult :: O.TestStrategy -> (String, ExpectedResult) -> TestTree
 expectedResult testStrategy (testName, (testDetails, expectedTestResult)) =
   testCase testName $ do
   -- whether we try to shrink or not is irrelevant as nothing will commute
     let result = runStrategyOn testStrategy O.NoShrinkFailure testDetails
     assertEqual "Unexpected result" expectedTestResult result
 
-genericRandomised :: O.TestStrategy -> Test
+genericRandomised :: O.TestStrategy -> TestTree
 genericRandomised testStrategy =
   testGroup (show testStrategy)
     [ testProperty "simple sequence" (simpleSequence testStrategy)
-    , testProperty "multi sequence" (multiSequence testStrategy)
+    , adjustOption (\(QuickCheckMaxSize n) -> QuickCheckMaxSize (n `div` 5)) $
+      testProperty "multi sequence" (multiSequence testStrategy)
     ]
 
-linearRandomised :: Test
+linearRandomised :: TestTree
 linearRandomised =
   testGroup (show O.Linear)
     [ testProperty "blame is found when possible" (findBlame O.Linear)
diff --git a/harness/Darcs/Test/Util/ConsoleFormat.hs b/harness/Darcs/Test/Util/ConsoleFormat.hs
new file mode 100644
index 00000000..7fdd979f
--- /dev/null
+++ b/harness/Darcs/Test/Util/ConsoleFormat.hs
@@ -0,0 +1,79 @@
+module Darcs.Test.Util.ConsoleFormat
+  ( ConsoleFormatType(..)
+  , stdFormat
+  , getFormat
+  )
+where
+
+import Darcs.Prelude
+
+import System.Environment (lookupEnv)
+import Text.Read (readMaybe)
+
+import Test.Tasty.Providers.ConsoleFormat
+    ( ConsoleFormat(..)
+    , failFormat
+    , infoFailFormat
+    , infoOkFormat
+    , okFormat
+    , skippedFormat
+    )
+
+-- | Enumeration of supported 'ConsoleFormat's
+--
+-- @since 1.5.1
+data ConsoleFormatType
+  = FormatFail
+  | FormatInfoFail
+  | FormatOk
+  | FormatInfoOk
+  | FormatSkipped
+
+-- | Default 'ConsoleFormat's
+--
+-- @since 1.5.1
+stdFormat :: ConsoleFormatType -> ConsoleFormat
+stdFormat FormatFail = failFormat
+stdFormat FormatInfoFail = infoFailFormat
+stdFormat FormatOk = okFormat
+stdFormat FormatInfoOk = infoOkFormat
+stdFormat FormatSkipped = skippedFormat
+
+-- | If the appropriate environment variable has been set,
+-- and can be parsed, return the 'ConsoleFormat' that it describes,
+-- otherwise use the standard format ('stdFormat').
+--
+-- An environment variable consists of three words that
+-- describe the 'ConsoleIntensity', 'ColorIntensity', and 'Color'
+-- of the format. Here is the definition of the standard formats:
+--
+-- > TASTY_FORMAT_FAIL="BoldIntensity Vivid Red"
+-- > TASTY_FORMAT_INFO_FAIL="NormalIntensity Dull Red"
+-- > TASTY_FORMAT_OK="NormalIntensity Dull Green"
+-- > TASTY_FORMAT_INFO_OK="NormalIntensity Dull White"
+-- > TASTY_FORMAT_SKIPPED="NormalIntensity Dull Magenta"
+--
+-- @since 1.5.1
+getFormat :: ConsoleFormatType -> IO ConsoleFormat
+getFormat t = do
+  mpal <- lookupEnv (formatName t)
+  case mpal of
+    Nothing -> return (stdFormat t)
+    Just pal ->
+      case parseFormatVal pal of
+        Just fmt -> return fmt
+        Nothing -> return (stdFormat t)
+  where
+    formatName :: ConsoleFormatType -> String
+    formatName FormatFail = "TASTY_FORMAT_FAIL"
+    formatName FormatInfoFail = "TASTY_FORMAT_INFO_FAIL"
+    formatName FormatOk = "TASTY_FORMAT_OK"
+    formatName FormatInfoOk = "TASTY_FORMAT_INFO_OK"
+    formatName FormatSkipped = "TASTY_FORMAT_SKIPPED"
+
+    parseFormatVal :: String -> Maybe ConsoleFormat
+    parseFormatVal str =
+      case words str of
+        [w1, w2, w3] ->
+          ConsoleFormat <$> readMaybe w1 <*> readMaybe w2 <*> readMaybe w3
+        _ -> Nothing
diff --git a/harness/Darcs/Test/Util/ConsoleReporter.hs b/harness/Darcs/Test/Util/ConsoleReporter.hs
new file mode 100644
index 00000000..1f51f060
--- /dev/null
+++ b/harness/Darcs/Test/Util/ConsoleReporter.hs
@@ -0,0 +1,403 @@
+-- vim:fdm=marker
+{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE MultiWayIf #-}
+{- | Console reporter ingredient. Adapted to Darcs from
+Test.Tasty.Providers.ConsoleReporter.
+
+Differences to the original:
+
+  * User customizable colors via environment variables, see 'getFormat'
+  * Use terminal width (if available) to
+    * truncate overlong test or group names
+    * align test result and timings
+    This means option AnsiTricks is not needed
+  * Remove support for option Quiet
+  * Connect test name and result with dots (easier to read with wide terminal)
+  * Remove the hook to display the test pattern for failed tests
+  * Do not change stdout to buffering
+
+-}
+module Darcs.Test.Util.ConsoleReporter
+  ( consoleTestReporter
+    -- re-exports
+  , HideSuccesses(..)
+  , UseColor(..)
+  ) where
+
+import Darcs.Prelude hiding ( EQ, fail )
+import Darcs.Test.Util.ConsoleFormat ( ConsoleFormatType(..), getFormat )
+
+import Control.Exception ( bracket_ )
+import Control.Monad ( unless, void, when )
+import Control.Monad.IO.Class ( liftIO )
+import Control.Monad.Trans.Reader ( Reader, ask, runReader )
+import Control.Monad.Trans.State ( evalStateT, get, modify, put )
+import Data.Maybe ( isJust )
+import Data.Monoid ( Any(..) )
+import Data.Proxy ( Proxy(..) )
+import Foreign.C.Types ( CInt(..) )
+import System.Console.ANSI
+    ( clearLine
+    , cursorUpLine
+    , hSupportsANSI
+    , hSupportsANSIColor
+    , hideCursor
+    , setCursorColumn
+    , showCursor
+    )
+import qualified System.Console.Terminal.Size as TS
+import System.IO ( hFlush, stdout )
+import Test.Tasty.Ingredients.ConsoleReporter
+    ( HideSuccesses(..)
+    , Statistics(..)
+    , TestOutput(..)
+    , UseColor(..)
+    , computeStatistics
+    , foldTestOutput
+    , useColor
+    , withConsoleFormat
+    )
+import Test.Tasty.Options ( OptionDescription(..), OptionSet, lookupOption )
+import Test.Tasty.Providers ( TestName )
+import Test.Tasty.Providers.ConsoleFormat ( ResultDetailsPrinter(..) )
+import Test.Tasty.Runners
+    ( Ap(..)
+    , FailureReason(..)
+    , Ingredient(..)
+    , Outcome(..)
+    , Result(..)
+    , StatusMap
+    , TestTree
+    , Time
+    , Traversal(..)
+    , foldGroup
+    , foldSingle
+    , foldTestTree
+    , formatMessage
+    , resultSuccessful
+    , trivialFold
+    )
+import Text.Printf ( printf )
+
+type Level = Int
+
+-- | Build the 'TestOutput' for a 'TestTree' and 'OptionSet'. The @colors@
+-- ImplicitParam controls whether the output is colored.
+--
+-- @since 0.11.3
+buildTestOutput
+  :: (?colors::Bool) => Maybe Int -> OptionSet -> TestTree -> TestOutput
+buildTestOutput width opts tree =
+  let
+    extraSpace = 13 -- for result and time
+    -- Do not retain the reference to the tree more than necessary
+    !alignment =
+      case width of
+        Just w -> w - extraSpace
+        Nothing -> computeAlignment opts tree
+
+    runSingleTest
+      :: (?colors :: Bool)
+      => OptionSet -> TestName -> t -> Ap (Reader Level) TestOutput
+    runSingleTest _opts name _test = Ap $ do
+      level <- ask
+
+      let
+        spaceForName = alignment - indentSize * level
+
+        printTestName = do
+          printf "%s%s"
+            (indent level)
+            (truncateName width (indentSize * level + extraSpace) name)
+          hFlush stdout
+
+        printTestResult result = do
+          printf " %s " (replicate (spaceForName - stringWidth name) '.')
+
+          rDesc <- formatMessage $ resultDescription result
+
+          -- use an appropriate printing function
+          let
+            printFn =
+              case resultOutcome result of
+                Success -> ok
+                Failure TestDepFailed -> skipped
+                _ -> fail
+            time = resultTime result
+          printFn (resultShortDescription result)
+          -- print time only if it's significant
+          when (time >= 0.01) $
+            printFn (printf " (%.2fs)" time)
+          printFn "\n"
+
+          when (not $ null rDesc) $
+            (if resultSuccessful result then infoOk else infoFail) $
+              printf "%s%s\n" (indent $ level + 1) (formatDesc (level+1) rDesc)
+          case resultDetailsPrinter result of
+            ResultDetailsPrinter action -> action level withConsoleFormat
+
+      return $ PrintTest name printTestName printTestResult
+
+    runGroup :: OptionSet -> TestName -> Ap (Reader Level) TestOutput -> Ap (Reader Level) TestOutput
+    runGroup _opts name grp = Ap $ do
+      level <- ask
+      let
+        printHeading =
+          printf ("%s%s\n") (indent level) (truncateName width (indentSize * level) name)
+        printBody = runReader (getApp grp) (level + 1)
+      return $ PrintHeading name printHeading printBody
+
+  in
+    flip runReader 0 $ getApp $
+      foldTestTree
+        trivialFold
+          { foldSingle = runSingleTest
+          , foldGroup = runGroup
+          }
+          opts tree
+
+-- }}}
+
+--------------------------------------------------
+-- TestOutput modes
+--------------------------------------------------
+-- {{{
+consoleOutput :: TestOutput -> StatusMap -> IO ()
+consoleOutput toutput smap =
+  getTraversal . fst $ foldTestOutput foldTest foldHeading toutput smap
+  where
+    foldTest _name printName getResult printResult =
+      ( Traversal $ do
+          printName :: IO ()
+          r <- getResult
+          printResult r
+      , Any True)
+    foldHeading _name printHeading (printBody, Any nonempty) =
+      ( Traversal $ do
+          when nonempty $ do printHeading :: IO (); getTraversal printBody
+      , Any nonempty
+      )
+
+consoleOutputHidingSuccesses :: TestOutput -> StatusMap -> IO ()
+consoleOutputHidingSuccesses toutput smap =
+  void . getApp $ foldTestOutput foldTest foldHeading toutput smap
+  where
+    foldTest _name printName getResult printResult =
+      Ap $ do
+          printName :: IO ()
+          r <- getResult
+          if resultSuccessful r
+            then do clearThisLine; return $ Any False
+            else do printResult r :: IO (); return $ Any True
+
+    foldHeading _name printHeading printBody =
+      Ap $ do
+        printHeading :: IO ()
+        Any failed <- getApp printBody
+        unless failed clearAboveLine
+        return $ Any failed
+
+    clearAboveLine = do cursorUpLine 1; clearThisLine
+    clearThisLine = do clearLine; setCursorColumn 0
+
+streamOutputHidingSuccesses :: TestOutput -> StatusMap -> IO ()
+streamOutputHidingSuccesses toutput smap =
+  void . flip evalStateT [] . getApp $
+    foldTestOutput foldTest foldHeading toutput smap
+  where
+    foldTest _name printName getResult printResult =
+      Ap $ do
+          r <- liftIO $ getResult
+          if resultSuccessful r
+            then return $ Any False
+            else do
+              stack <- get
+              put []
+
+              liftIO $ do
+                sequence_ $ reverse stack
+                printName :: IO ()
+                printResult r :: IO ()
+
+              return $ Any True
+
+    foldHeading _name printHeading printBody =
+      Ap $ do
+        modify (printHeading :)
+        Any failed <- getApp printBody
+        unless failed $
+          modify $ \stack ->
+            case stack of
+              _:rest -> rest
+              [] -> [] -- shouldn't happen anyway
+        return $ Any failed
+
+-- }}}
+
+--------------------------------------------------
+-- Statistics
+--------------------------------------------------
+-- {{{
+
+reportStatistics :: (?colors :: Bool) => Statistics -> IO ()
+reportStatistics st = case statFailures st of
+    0 -> ok $ printf "All %d tests passed" (statTotal st)
+    fs -> fail $ printf "%d out of %d tests failed" fs (statTotal st)
+
+-- | @printStatistics@ reports test success/failure statistics and time it took
+-- to run. The 'Time' results is intended to be filled in by the 'TestReporter'
+-- callback. The @colors@ ImplicitParam controls whether coloured output is
+-- used.
+--
+-- @since 0.11.3
+printStatistics :: (?colors :: Bool) => Statistics -> Time -> IO ()
+printStatistics st time = do
+  printf "\n"
+  reportStatistics st
+  case statFailures st of
+    0 -> ok $ printf " (%.2fs)\n" time
+    _ -> fail $ printf " (%.2fs)\n" time
+
+-- }}}
+
+--------------------------------------------------
+-- Console test reporter
+--------------------------------------------------
+-- {{{
+
+consoleTestReporterOptions :: [OptionDescription]
+consoleTestReporterOptions =
+  [ Option (Proxy :: Proxy HideSuccesses)
+  , Option (Proxy :: Proxy UseColor)
+  ]
+
+consoleTestReporter :: Ingredient
+consoleTestReporter =
+  TestReporter consoleTestReporterOptions consoleTestReportImplementation
+
+consoleTestReportImplementation
+  :: OptionSet -> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool))
+consoleTestReportImplementation opts tree = Just $ \smap -> do
+  let
+    whenColor = lookupOption opts
+    HideSuccesses hideSuccesses = lookupOption opts
+  terminalWidth <- fmap TS.width <$> TS.hSize stdout
+  isTerm <- hSupportsANSI stdout
+  isTermColor <- hSupportsANSIColor stdout
+  bracket_ (when isTerm hideCursor) (when isTerm showCursor) $ do
+    let ?colors = useColor whenColor isTermColor
+    let toutput = buildTestOutput terminalWidth opts tree
+    if
+      | hideSuccesses && isTerm && isJust terminalWidth ->
+          consoleOutputHidingSuccesses toutput smap
+      | hideSuccesses ->
+          streamOutputHidingSuccesses toutput smap
+      | otherwise -> consoleOutput toutput smap
+    return $ \time -> do
+      stats <- computeStatistics smap
+      printStatistics stats time
+      return $ statFailures stats == 0
+
+-- }}}
+
+--------------------------------------------------
+-- Formatting
+--------------------------------------------------
+-- {{{
+
+indentSize :: Int
+indentSize = 2
+
+indent :: Int -> String
+indent n = replicate (indentSize * n) ' '
+
+truncateName :: Maybe Int -> Int -> String -> String
+truncateName Nothing _ s = s
+truncateName (Just w) extra s =
+  case splitAt (w - extra) s of
+    (short,rest)
+      | length rest > 0 -> take (w - extra - 5) short ++ "[...]"
+      | otherwise -> short
+
+-- handle multi-line result descriptions properly
+formatDesc
+  :: Int -- indent
+  -> String
+  -> String
+formatDesc n desc =
+  let
+    -- remove all trailing linebreaks
+    chomped = reverse . dropWhile (== '\n') . reverse $ desc
+
+    multiline = '\n' `elem` chomped
+
+    -- we add a leading linebreak to the description, to start it on a new
+    -- line and add an indentation
+    paddedDesc = flip concatMap chomped $ \c ->
+      if c == '\n'
+        then c : indent n
+        else [c]
+  in
+    if multiline
+      then paddedDesc
+      else chomped
+
+data Maximum a
+  = Maximum a
+  | MinusInfinity
+
+instance Ord a => Semigroup (Maximum a) where
+  Maximum a <> Maximum b = Maximum (a `max` b)
+  MinusInfinity <> a = a
+  a <> MinusInfinity = a
+instance Ord a => Monoid (Maximum a) where
+  mempty = MinusInfinity
+  mappend = (<>)
+
+-- | Compute the amount of space needed to align \"OK\"s and \"FAIL\"s
+computeAlignment :: OptionSet -> TestTree -> Int
+computeAlignment opts =
+  fromMonoid .
+  foldTestTree
+    trivialFold
+      { foldSingle = \_ name _ level -> Maximum (stringWidth name + level)
+      , foldGroup = \_opts _ m -> m . (+ indentSize)
+      }
+    opts
+  where
+    fromMonoid m =
+      case m 0 of
+        MinusInfinity -> 0
+        Maximum x -> x
+
+-- | Compute the length/width of the string as it would appear in a monospace
+--   terminal.
+stringWidth :: String -> Int
+stringWidth = sum . map charWidth where
+  charWidth c = case wcwidth9 (fromIntegral (fromEnum c)) of
+        -1 -> 1  -- non-printable, combining or unassigned character
+        -2 -> 1  -- ambiguous width character
+        -3 -> 1  -- private-use character
+        w  -> fromIntegral w
+foreign import capi safe "wcwidth9.h wcwidth9" wcwidth9 :: CInt -> CInt
+
+-- (Potentially) colorful output
+ok, fail, skipped, infoOk, infoFail :: (?colors :: Bool) => String -> IO ()
+fail     = output FormatFail
+ok       = output FormatOk
+skipped  = output FormatSkipped
+infoOk   = output FormatInfoOk
+infoFail = output FormatInfoFail
+
+output
+  :: (?colors :: Bool)
+  => ConsoleFormatType
+  -> String
+  -> IO ()
+output formatType str = do
+  format <- getFormat formatType
+  withConsoleFormat format (putStr str)
+
+-- }}}
diff --git a/harness/Darcs/Test/Util/TestResult.hs b/harness/Darcs/Test/Util/TestResult.hs
index cf7b6881..081863f7 100644
--- a/harness/Darcs/Test/Util/TestResult.hs
+++ b/harness/Darcs/Test/Util/TestResult.hs
@@ -6,6 +6,7 @@ module Darcs.Test.Util.TestResult
   , maybeFailed
   , assertNotFailed
   , isFailed
+  , classify
   ) where
 
 import Darcs.Prelude
@@ -23,17 +24,17 @@ import qualified Test.HUnit as H
 -- failed, rejecting if both results are rejected, and otherwise
 -- succeeding.
 data TestResult
-  = TestSucceeded
+  = TestSucceeded [(Bool,String)]
   | TestFailed Doc
   | TestRejected
 
 instance Show TestResult where
-  show TestSucceeded = "TestSucceeded"
+  show (TestSucceeded _) = "TestSucceeded"
   show (TestFailed reason) = "TestFailed: " ++ unsafeRenderStringColored reason
   show TestRejected = "TestRejected"
 
 succeeded :: TestResult
-succeeded = TestSucceeded
+succeeded = TestSucceeded []
 
 failed :: Doc -> TestResult
 failed = TestFailed
@@ -41,13 +42,17 @@ failed = TestFailed
 rejected :: TestResult
 rejected = TestRejected
 
+classify :: Bool -> String -> TestResult -> TestResult
+classify cond label (TestSucceeded cs) = TestSucceeded ((cond,label):cs)
+classify _ _ tr = tr
+
 instance Semigroup TestResult where
   -- Succeed even if one of the arguments is rejected.
   t@(TestFailed _) <> _s = t
   _t <> s@(TestFailed _) = s
   TestRejected <> s = s
   t <> TestRejected = t
-  TestSucceeded <> TestSucceeded = TestSucceeded
+  TestSucceeded cs1 <> TestSucceeded cs2 = TestSucceeded (cs1 <> cs2)
 
 instance Monoid TestResult where
   mempty = TestRejected
@@ -64,14 +69,16 @@ isFailed _other = False
 
 -- | Convert 'TestResult' to HUnit testable assertion
 assertNotFailed :: TestResult -> H.Assertion
-assertNotFailed TestSucceeded = return ()
+assertNotFailed (TestSucceeded _) = return ()
 assertNotFailed TestRejected = return ()
 assertNotFailed (TestFailed msg) = H.assertString (unsafeRenderStringColored msg)
 
 -- | 'Testable' instance is defined by converting 'TestResult' to
 -- 'QuickCheck.Property.Result'
 instance Q.Testable TestResult where
-  property TestSucceeded = Q.property Q.succeeded
+  property (TestSucceeded []) = Q.property Q.succeeded
+  property (TestSucceeded (c:cs)) =
+    uncurry Q.classify c (Q.property (TestSucceeded cs))
   property (TestFailed errorMsg) =
     Q.property (Q.failed {Q.reason = unsafeRenderStringColored errorMsg})
   property TestRejected = Q.property Q.rejected
diff --git a/harness/test.hs b/harness/test.hs
index d61b221f..d03c6e56 100644
--- a/harness/test.hs
+++ b/harness/test.hs
@@ -16,34 +16,56 @@ import Control.Concurrent ( setNumCapabilities )
 import Control.Monad ( filterM, unless, when )
 import Data.List ( isPrefixOf, isSuffixOf, sort )
 import GHC.IO.Encoding ( textEncodingName )
-import System.Console.CmdArgs hiding ( args )
+import System.Console.CmdArgs hiding ( args, Quiet )
 import System.Console.CmdArgs.Explicit ( process )
 import System.Directory ( doesFileExist, doesPathExist, exeExtension, listDirectory )
+import System.Environment ( setEnv )
 import System.Environment.FindBin ( getProgPath )
 import System.FilePath ( isAbsolute, takeBaseName, takeDirectory, (</>) )
 import System.IO ( BufferMode(NoBuffering), hSetBuffering, localeEncoding, stdout )
-import Test.Framework
-    ( ColorMode(..)
-    , RunnerOptions'(..)
-    , Seed(..)
-    , TestOptions'(..)
-    , defaultMainWithOpts
+import System.Exit ( exitFailure )
+
+import Test.Tasty ( {- Timeout(..), -} testGroup )
+import Test.Tasty.Ingredients ( tryIngredients )
+import Darcs.Test.Util.ConsoleReporter
+    ( HideSuccesses(..)
+    , UseColor(..)
+    , consoleTestReporter
+    )
+import Test.Tasty.LeanCheck ( LeanCheckTests(..) )
+import Test.Tasty.Options ( OptionSet, defaultValue, singleOption )
+import Test.Tasty.Patterns.Types ( Expr(Or) )
+import Test.Tasty.QuickCheck
+    ( QuickCheckMaxRatio(..)
+{-
+    , QuickCheckMaxShrinks(..)
+    , QuickCheckMaxSize(..)
+-}
+    , QuickCheckReplay(..)
+{-
+    , QuickCheckShowReplay(..)
+-}
+    , QuickCheckTests(..)
+    , QuickCheckVerbose(..)
     )
+import Test.Tasty.Runners ( NumThreads(..), TestPattern(..), parseExpr )
+
 
 data Config = Config { suites :: String
                      , formats :: String
                      , diffalgs :: String
                      , index :: String
                      , cache :: String
+                     , failing :: String
                      , full :: Bool
                      , darcs :: String
-                     , tests :: [String]
+                     , patterns :: [String]
                      , testDir :: Maybe FilePath
                      , ghcFlags :: String
                      , plain :: Bool
                      , hideSuccesses :: Bool
                      , threads :: Int
-                     , qcCount :: Int
+                     , count :: Int
                      , replay :: Maybe Int
                      }
             deriving (Data, Typeable, Eq, Show)
@@ -52,20 +74,21 @@ data Config = Config { suites :: String
 defaultConfigAnn :: Annotate Ann
 defaultConfigAnn
  = record Config{}
-     [ suites        := "snu"    += help "Select which test suites to run: (s=shell, n=network, u=unit, f=failing, h=hashed) [snu]" += typ "SET"
+     [ suites        := "snu"    += help "Select which test suites to run: (s=shell, n=network, u=unit, h=hashed) [snu]" += typ "SET"
      , formats       := "123"    += help "Select which darcs formats to test: (1=darcs-1, 2=darcs-2, 3=darcs-3) [123]" += name "f" += typ "SET"
      , diffalgs      := "p"      += help "Select which diff alorithms to use (p=patience, m=myers) [p]" += name "a" += typ "SET"
      , index         := "y"      += help "Select whether to use the index (n=no, y=yes) [y]" += typ "SET"
      , cache         := "y"      += help "Select whether to use the cache (n=no, y=yes) [y]" += typ "SET"
+     , failing       := "n"      += help "Select whether to use failing tests (n=no, y=yes) [n]" += typ "SET"
      , full          := False    += help "Shortcut for -s=snu -f=123 -a=mp -c=yn -i=yn"
      , darcs         := ""       += help "Darcs binary path" += typ "PATH"
-     , tests         := []       += help "Pattern to limit the tests to run" += typ "PATTERN" += name "t"
+     , patterns      := []       += help "Pattern to limit the tests to run" += typ "PATTERN" += name "t"
      , testDir       := Nothing  += help "Directory to run tests in" += typ "PATH" += name "d"
      , ghcFlags      := ""       += help "GHC flags to use when compiling tests" += typ "FLAGS" += name "g"
      , plain         := False    += help "Use plain-text output [no]"
      , hideSuccesses := False    += help "Hide successes [no]"
      , threads       := 1        += help "Number of threads [1]" += name "j"
-     , qcCount       := 100      += help "Number of QuickCheck iterations per test [100]" += name "q"
+     , count         := 100      += help "Number of Quick/LeanCheck iterations per test [100]" += name "q"
      , replay        := Nothing  += help "Replay QC tests with given seed" += typ "SEED"
      ]
    += summary "Darcs test harness"
@@ -121,7 +144,6 @@ run conf = do
           when e $ die ("Directory " ++ d ++ " already exists. Cowardly exiting")
 
     let hashed   = 'h' `elem` suites conf
-        failing  = 'f' `elem` suites conf
         shell    = 's' `elem` suites conf
         network  = 'n' `elem` suites conf
         unit     = 'u' `elem` suites conf
@@ -139,11 +161,14 @@ run conf = do
         nocache   = 'n' `elem` cache conf
         withcache = 'y' `elem` cache conf
 
+        withFailing    = 'y' `elem` failing conf
+        withSucceeding = 'n' `elem` failing conf
+
     darcsBin <-
       case darcs conf of
         "" -> findDarcs
         v -> return v
-    when (shell || network || failing) $ do
+    when (shell || network) $ do
       unless (isAbsolute $ darcsBin) $
         die ("Argument to --darcs should be an absolute path")
       unless (exeExtension `isSuffixOf` darcsBin) $
@@ -170,60 +195,82 @@ run conf = do
     let findTestFiles dir = select . map (dir </>) <$> listDirectory dir
           where
             filter_failing =
-              if failing
-                then id
-                else filter $ not . ("failing-" `isPrefixOf`) . takeBaseName
+              case (withFailing, withSucceeding) of
+                (True,True) -> id -- "yn"
+                (False,True) -> -- "n"
+                  filter $ not . ("failing-" `isPrefixOf`) . takeBaseName
+                (True,False) -> -- "y"
+                  filter $ ("failing-" `isPrefixOf`) . takeBaseName
+                (False,False) -> const [] -- ""
             select = sort . filter_failing . filter (".sh" `isSuffixOf`)
 
     stests <-
       if shell
         then do
           files <- findTestFiles "tests"
-          findShell darcsBin files (testDir conf) (ghcFlags conf) diffAlgorithm
-            repoFormat useIndex useCache
+          return $
+            genShellTests darcsBin files (testDir conf) (ghcFlags conf) diffAlgorithm
+              repoFormat useIndex useCache
         else return []
     ntests <-
       if network
         then do
           files <- findTestFiles "tests/network"
-          findShell darcsBin files (testDir conf) (ghcFlags conf) diffAlgorithm
-            repoFormat useIndex useCache
+          return $
+            genShellTests darcsBin files (testDir conf) (ghcFlags conf) diffAlgorithm
+              repoFormat useIndex useCache
         else return []
     let utests =
           if unit then
-            [ Darcs.Test.Email.testSuite
-            , Darcs.Test.Misc.testSuite
-            , Darcs.Test.Repository.Inventory.testSuite
+            [ Darcs.Test.Email.testSuite ] ++
+            Darcs.Test.Misc.testSuite ++
+            [ Darcs.Test.Repository.Inventory.testSuite
             , Darcs.Test.UI.testSuite
             ] ++
             Darcs.Test.Patch.testSuite
           else []
         hstests = if hashed then Darcs.Test.HashedStorage.tests else []
 
-    let testRunnerOptions = RunnerOptions
-          { ropt_threads = Just (threads conf)
-          , ropt_test_options = Just $ TestOptions
-              { topt_seed = FixedSeed <$> replay conf
-              , topt_maximum_generated_tests = Just (qcCount conf)
-              , topt_maximum_unsuitable_generated_tests = Just (7 * qcCount conf)
-              , topt_maximum_test_size = Nothing
-              , topt_maximum_test_depth = Nothing
-              , topt_timeout = Nothing
-              }
-          , ropt_test_patterns =
-              if null (tests conf) then Nothing else Just (map read (tests conf))
-          , ropt_xml_output = Nothing
-          , ropt_xml_nested = Nothing
-          , ropt_color_mode = if plain conf then Just ColorNever else Nothing
-          , ropt_hide_successes = Just (hideSuccesses conf)
-          , ropt_list_only = Nothing
-          }
-    defaultMainWithOpts (stests ++ utests ++ ntests ++ hstests) testRunnerOptions
+    exprs <-
+      case patterns conf of
+        [] -> return Nothing
+        ps ->
+          case mapM parseExpr ps of
+            Just exprs -> return $ Just exprs
+            Nothing -> fail "invalid pattern(s)"
+    let core_options = mconcat
+          [ singleOption $ HideSuccesses $ hideSuccesses conf
+          , singleOption $ if plain conf then Never else Auto
+          , singleOption $ NumThreads $ threads conf
+          -- , singleOption $ NoTimeout -- default; else @mkTimeout 20_000_000@
+          , singleOption $ TestPattern $ foldr1 (Or) <$> exprs
+          ]
+    let lc_options = singleOption $ LeanCheckTests (count conf)
+    let qc_options = mconcat
+          [ singleOption $
+            case defaultValue of -- default is 10
+              QuickCheckMaxRatio n -> QuickCheckMaxRatio (7 * n)
+          -- , singleOption $ QuickCheckMaxShrinks maxBound -- default
+          -- , singleOption $ QuickCheckMaxSize 100 -- default
+          , singleOption $ QuickCheckReplay $ replay conf
+          -- , singleOption $ QuickCheckShowReplay True -- default
+          , singleOption $ QuickCheckTests $ count conf -- default is 100
+          , singleOption $ QuickCheckVerbose False
+          ]
+    let options :: OptionSet = mconcat [core_options, qc_options, lc_options]
+    let all_tests =
+          testGroup "All Tests" $ stests ++ utests ++ ntests ++ hstests
+    case tryIngredients [consoleTestReporter] options all_tests of
+      Nothing -> fail "no ingredient found"
+      Just runIngredient -> do
+        result <- runIngredient
+        unless result exitFailure
 
 main :: IO ()
 main = do hSetBuffering stdout NoBuffering
           clp  <- cmdArgs_ defaultConfigAnn
           setNumCapabilities (threads clp)
+          setEnv "DARCS_ESCAPE_8BIT" "1"
           run $
             if full clp then clp
               { formats  = "123"
diff --git a/release/distributed-context b/release/distributed-context
index 4fbe6620..df9e78bc 100644
--- a/release/distributed-context
+++ b/release/distributed-context
@@ -1 +1 @@
-Just "\nContext:\n\n\n[cabal file: add hie flag\nBen Franksen <ben.franksen@online.de>**20240510175237\n Ignore-this: 1d42ad05750e08d23ec0f6a387c08ceb051de31ec48a97826573f14a56e3a0ae16584ed3577f82c0\n] \n\n[ci: upgrade actions/cache, fix cache/save warnings\nBen Franksen <ben.franksen@online.de>**20240510155801\n Ignore-this: 1b2f726a24693810ec0fe995af9a0be968ca86728cc26758ca9582516968397ca1d3b4be1c478a8b\n] \n\n[resolve issue2718: avoid using conflictedPaths to detect whether we have conflicts\nBen Franksen <ben.franksen@online.de>**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 <ben.franksen@online.de>**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 <ben.franksen@online.de>**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 <ben.franksen@online.de>**20240506183723\n Ignore-this: fcab2e01d6fe9dc16facda2a569eeb4454c3c1208cdcd31bb9c630334290de1de6dba8d5611666d9\n] \n\n[put back the set-default hint\nGanesh Sittampalam <ganesh@earth.li>**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 <ganesh@earth.li>**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 <vekhir@yahoo.com>\n] \n\n[Darcs.UI.External: fix warnings about head\nGanesh Sittampalam <ganesh@earth.li>**20240225215257\n Ignore-this: 35ed1b4cd0f4c1af70133228547dac7fce5067a1482cbe6810c515f82389d70cb1f2bed0a7a32fc9\n] \n\n[Darcs.UI.Commands.ShowAuthors: fix warnings about head\nGanesh Sittampalam <ganesh@earth.li>**20240225215214\n Ignore-this: ee64bb835284ac05403ea170915e8ed2191de27042e69edea61f5743bd752ea14e44082f54d90f9a\n] \n\n[use headErr/tailErr from safe for several head/tails\nGanesh Sittampalam <ganesh@earth.li>**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 <ganesh@earth.li>**20240225215135\n Ignore-this: 740956f48bd3127b4f77c0c7350b8d229e0fd7be3bda48932a61341169cc976d6e7ed3dedc7cad11\n] \n\n[Darcs.UI.Commands.Record: fix warning about head\nGanesh Sittampalam <ganesh@earth.li>**20240225205552\n Ignore-this: e288796d05da69107f281ccd311e1980cfc7d71aaab72b3c2ab2619c0f1ceaff76a497ae37705689\n] \n\n[Darcs.UI.Commands.Convert.Import: fix warning about head\nGanesh Sittampalam <ganesh@earth.li>**20240225205524\n Ignore-this: a8c51b94ff04c6bed7959f43c3d518d6171048755646fd1146a7996ac6d5c5013db900b51ff29504\n] \n\n[Darcs.UI.Commands.Convert.Export: fix warnings about tail\nGanesh Sittampalam <ganesh@earth.li>**20240225204214\n Ignore-this: a49d956016082487081f71fcace360f65cb92ad17e10e195651821d6e009b70b9d01b49a2b0c8708\n] \n\n[add some tests for Darcs.UI.Commands.Convert.Export.patchAuthor\nGanesh Sittampalam <ganesh@earth.li>**20240225204119\n Ignore-this: 4a3a731c86732c64a27b9e9719950e01a94ef320b37259113c693e75080283806a23835c423e40b9\n] \n\n[darcs.hs: fix warnings about head/tail\nGanesh Sittampalam <ganesh@earth.li>**20240225201516\n Ignore-this: 8f6fec34b8e77474a3b1ee5e252fb08fe8439c57a4a0ad35df64c06fe15df18f83c82855d8435e15\n] \n\n[Darcs.Patch.Info: fix warning about head\nGanesh Sittampalam <ganesh@earth.li>**20240225195147\n Ignore-this: f50bcf1a170c6c8941c688021e20d1eee24e59b2afe7a5f01488c9c4f2cb92d58aed586f146a0a98\n] \n\n[Darcs.Util.Diff.Patience: fix warning about head\nGanesh Sittampalam <ganesh@earth.li>**20240225194009\n Ignore-this: ccfaccc22725d81839f5caf605742eb7f3ef916572fdd7a53bcc7f7fa837ef9d71729e7c71d4503\n] \n\n[Darcs.Patch.Annotate: fix warning about head\nGanesh Sittampalam <ganesh@earth.li>**20240225182503\n Ignore-this: 4c48b8aadee71311e2a01f5b53a678e07f53339d98e843ebc01ebd381163fe0a9d7f3721c2c5dc58\n] \n\n[bump version to 2.19.1\nGanesh Sittampalam <ganesh@earth.li>**20240225175930\n Ignore-this: b8e8df00de306f7de2363d1805c152be15cc5b5ab99a57be8f9db19bb8552d0d25a196eeb2dc20c4\n] \n\n[TAG 2.18.1\nGanesh Sittampalam <ganesh@earth.li>**20240225173219\n Ignore-this: dc3a92eafcab9d4fa9f53b1811d4c99d330615a8c202bff1b77f44d551d21684eee81e96c69be62b\n] \n"
\ No newline at end of file
+Just "\nContext:\n\n\n[rename PatchTree to PatchSeq\nBen Franksen <ben.franksen@online.de>**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[patch index: cleanup doc comments\nBen Franksen <ben.franksen@online.de>**20210610120909\n Ignore-this: 8338b392d1a22f71122e0c2f6bd7fcfc4524fed5ed473967aaf586ebab535b0ccc0c77783007778a\n] \n\n[patch index: optimize Set Word32 -> IntSet\nBen Franksen <ben.franksen@online.de>**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 <ben.franksen@online.de>**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[improve doc comment for D.U.Path.parents\nBen Franksen <ben.franksen@online.de>**20210610114804\n Ignore-this: 224d8265f15847261f6abd1d74ce0a30d8bd811d696a95da9fc6e4005efe8f6b142927c98507ba7c\n] \n\n[patch index: reformat a doc comment\nBen Franksen <ben.franksen@online.de>**20210610120501\n Ignore-this: 665a824caca2b970d25fabf22eb85d688bec52632d00d77ee9ebeb292d32d473856329b9aebb4d9c\n] \n\n[patch index: import from Darcs.Patch.Index.Types explicitly\nBen Franksen <ben.franksen@online.de>**20210610120619\n Ignore-this: 55342c521619ad0b3d0a206affc765a6b6214b62f22166e71057b4349e4d482a5663e5081f55bfa4\n] \n\n[patch index: debug messages when loading\nBen Franksen <ben.franksen@online.de>**20210610120949\n Ignore-this: 66b640cde02f352c7905afe48b4cfa6067b041f3ebc1af5e6389ea565e428b05ddbb607a9d0cb0f4\n] \n\n[patch index: remove another kludge for broken move patches\nBen Franksen <ben.franksen@online.de>**20210610190038\n Ignore-this: d5fa46e3cfd90d65313facc204d8cbdada8048b223468f79272f9c3830474807c224364ab25677ac\n] \n\n[D.U.Cache: break some overlong code lines\nBen Franksen <ben.franksen@online.de>**20210530174641\n Ignore-this: 8e376bfa92254f13ec103fe4d8b1cc6504018a4d4b7e15acfc9f7797e1c144c6b2c14cc14c103046\n] \n\n[D.U.Cache: improve docs for copyFileUsingCache\nBen Franksen <ben.franksen@online.de>**20210530083923\n Ignore-this: 34f94013864d23ecacbe848fb23864b6a7dbb66242bfe55c325eff647ec14ec1645cee1fdb184bb5\n] \n\n[D.U.Cache: break an overlong comment line\nBen Franksen <ben.franksen@online.de>**20210530082750\n Ignore-this: d67397d305b96eb47622d0ac37fc262d86f462019d528ee57bbe57bfb017d3c952c77684d4d25635\n] \n\n[D.U.Cache: if -> case\nBen Franksen <ben.franksen@online.de>**20210530082718\n Ignore-this: 1186063d9c7ca5ceba5b70944ccbe795855ed7dd534560c9a750aa9d6ff7704daa0fa3832968206e\n] \n\n[allow rebase unsuspend when there are unrecorded changes\nBen Franksen <ben.franksen@online.de>**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 <ben.franksen@online.de>**20210302185613\n Ignore-this: 7301a87235935506314c35baedd42387e7cd1abc298a1c61631b3fdc72dfadd2b3367c44a16bd7cc\n] \n\n[tests/broken_move.sh: adapt to better apply error messages\nBen Franksen <ben.franksen@online.de>**20210317074545\n Ignore-this: 999e8c6a0f46b5b2084dca38822af25cf68c9e324f3a5a3e5329397d774d95993cac3c3b9667eb6a\n] \n\n[trivial refactor in D.R.Unrevert for better readability\nBen Franksen <ben.franksen@online.de>**20210306060231\n Ignore-this: 33b6dab0bdf4c7833846f97e9ba629d94924df46e9456e6a714fe70323b2caf09b9bd5f38b1a374b\n] \n\n[fix: add missing dry-run guards when calling applyToWorking\nBen Franksen <ben.franksen@online.de>**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[refactor rebase unsuspend\nBen Franksen <ben.franksen@online.de>**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[remove the unsafe tentativelyAddToPending, replace with addToPending\nBen Franksen <ben.franksen@online.de>**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[remove command: fix code layout of makeRemovePatch\nBen Franksen <ben.franksen@online.de>**20210306081307\n Ignore-this: 3c304915cb90f06dadd0b983c8b6e2c1ffddb86159b396a7e542cbd32cf46e5eab3e32d76e84fade\n] \n\n[rename addPendingDiffToPending to unsafeAddToPending\nBen Franksen <ben.franksen@online.de>**20210302132611\n Ignore-this: c64370f6ea0a98e2db90a644b6ac511751f998fdb4182c42de9f18ff1c2c8f3dd8a9849800da8236\n] \n\n[refactor askAboutDepends and updatePatchHeader\nBen Franksen <ben.franksen@online.de>**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[convert import/darcs-2: recognize the compress and diffAlgorithm options\nBen Franksen <ben.franksen@online.de>**20210303145001\n Ignore-this: 85558b53cb6d96f71f8f685002d80e3a8f41fa88b023194b59df8fa17f2436eab6aeb1f95ea6ebc3\n \n This avoids hard-coding some arbitrarily chosen value.\n] \n\n[push command: simplify some type signatures\nBen Franksen <ben.franksen@online.de>**20210306155755\n Ignore-this: d33ae7076991232fb40a0f3bb39582d95bb6ef49c609bdaec14107d1e23b45571414ce90004b0a50\n] \n\n[clean up getRecordedUpToMatch and the commands that use it\nBen Franksen <ben.franksen@online.de>**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[remove the useless optimize pristine subcommand\nBen Franksen <ben.franksen@online.de>**20210510113544\n Ignore-this: 1c75fd4ccfbe80df50059810df5d91dcf60cc4fd7c5b6715a01ec5761df701a451a636763f654133\n \n Upgrading the pristine from the size-prefixed format is done automatically.\n] \n\n[generalize readPatchesHashed and use in readTentativePatches\nBen Franksen <ben.franksen@online.de>**20210327055207\n Ignore-this: 5c1771aacdbc2ee22e02e37e46b5b72621c02fa5bfa5b703ea803da6a7854c13c3529170d1fbc57b\n] \n\n[return hash from writePristine\nBen Franksen <ben.franksen@online.de>**20210324172607\n Ignore-this: 92cfee04b27714e70f51b42bb3c107c231f17ba497071e89dd04b6054911259a782a66260c03c562\n] \n\n[fix the order of parameters to Tagged\nBen Franksen <ben.franksen@online.de>**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[simplify writeInventory and writeTentativeInventory\nBen Franksen <ben.franksen@online.de>**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[TreeMonad: explicit import of D.U.Path, some simplifications\nBen Franksen <ben.franksen@online.de>**20210316072251\n Ignore-this: bd080c44431b62746a21a1f508eb3a1b03f41993494e26290d09b16eb92f2f9af9849eb781ca92e6\n] \n\n[better error handling when applying patches\nBen Franksen <ben.franksen@online.de>**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[replace readTentativePatches with readPatches\nBen Franksen <ben.franksen@online.de>**20210301201958\n Ignore-this: 98d4665d77887ce616540cc11ade28616e4c1458303a8341e01a479bebde69c383dfb905bc6b0bd\n] \n\n[fix TODO item in remove command\nBen Franksen <ben.franksen@online.de>**20210306083156\n Ignore-this: be3afd76238a64f34c901ad96dc98509d44042c6a90e698317d3cb9b8d4dfdc62f9ddbac796f910f\n] \n\n[import tentativelyRemoveFromPW via Darcs.Repository\nBen Franksen <ben.franksen@online.de>**20210301152620\n Ignore-this: bb37ef9fe31d2be6d830cf23faff248870b333e4040f91b84fa6b0c0f966d90526f22f12dea71788\n] \n\n[remove out-commented code in D.UI.C.Repair\nBen Franksen <ben.franksen@online.de>**20210324060633\n Ignore-this: 9011bab75c4606569b79622691514c6dbee913d0b9bcd6aed72f4ccde433971a5f49ad7f9a95fdb6\n] \n\n[rename unrevertPatchBundle to readUnrevert\nBen Franksen <ben.franksen@online.de>**20210325082039\n Ignore-this: 90e0bfd9e1cb4711e33a8a351fcec1f58d9b0136740ff7a1468e1057204c35c2372316d7c53074cf\n] \n\n[lift writeInventoryPrivate to the top level and rename to writeInventory\nBen Franksen <ben.franksen@online.de>**20201103063416\n Ignore-this: ec7d61553da2ce9972616ec2ef2d3e63f4158d3b054f34ad41ea26ec3ef9d5a0d66b08e9e1f153a5\n] \n\n[use withRepoDir in createPacks\nBen Franksen <ben.franksen@online.de>**20210315162432\n Ignore-this: b7141bfd23d7c787f27eb919010c08aec95162bffbfe4775fdff3a1e5868c5a85a46e331290f86d9\n \n This simplifies its use in darcsden.\n] \n\n[move hash validation from D.R.Inventory to D.Util.Cache\nBen Franksen <ben.franksen@online.de>**20210327075324\n Ignore-this: d020f2ac5800819b5eba063a53901aa2f64ccb1222354bad6ed556d89a67945d273e225fb3c39ad9\n] \n\n[move D.R.Inventory to D.R.Inventory.Format\nBen Franksen <ben.franksen@online.de>**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[fix generator for hashes in D.T.R.Inventory\nBen Franksen <ben.franksen@online.de>**20210324023216\n Ignore-this: 942b9deff9c67365da5f57e55670502bd5892dd64771edc5e69cca26e5ab426c8f5d215c3d5b9682\n] \n\n[validate hashes in inventories on the ByteString side\nBen Franksen <ben.franksen@online.de>**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 <ben.franksen@online.de>**20210308093608\n Ignore-this: 9c03b65a47f366271b0beee735a3e8d6b5e72fe0031d405d4d701caee84c89fc646e8d3408493b18\n] \n\n[cache: refactor cacheHash and remove export\nBen Franksen <ben.franksen@online.de>**20210307101410\n Ignore-this: bb33fb17c07c2e8300ceb4731969faf823dc175a37e6fc2881ff4a00160a0a97b7b26a4e7ba79e05\n] \n\n[use ShortByteString for Hash content\nBen Franksen <ben.franksen@online.de>**20210307162525\n Ignore-this: 343006f7acead5b3f3d044b3454fc7e6370d7d9ec177b13f45bf9c365c88b0e4a8e414a128c1cb37\n \n This should bring down memory use and decrease fragmentation.\n] \n\n[cache: inline copyFilesUsingCache\nBen Franksen <ben.franksen@online.de>**20210307101327\n Ignore-this: 1039cb3158ce64caec81b74958e68546a7c5c1f6ff62a7cc5b1adfe3ade34b49bbc3bcf03d100b5d\n] \n\n[fix in checkSuspendedStatus and maybeDisplaySuspendedStatus\nBen Franksen <ben.franksen@online.de>**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[convert darcs-2: remove intermediate commits\nBen Franksen <ben.franksen@online.de>**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 <ben.franksen@online.de>**20210303143641\n Ignore-this: 4178cc4194d62d3fa7593c1eef428eed7ce98933308d1614584e683cc3b3030021553fb0acb605bf\n] \n\n[convert darcs-2: add a final call to finalizeRepositoryChanges\nBen Franksen <ben.franksen@online.de>**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: exclude macOS-10.15 && ghc-8.10.4\nBen Franksen <ben.franksen@online.de>**20210611183809\n Ignore-this: 315739f6a58998368cf6dd068d4da8e459374681914f08b0dffc21d923fdc08aef6f6da3d301d699\n] \n\n[get rid of \"nasty hack\" in applyPatchesForRebaseCmd\nBen Franksen <ben.franksen@online.de>**20210302104856\n Ignore-this: 4a83d729e21985c54f7431099874563338df07e206c87e680d80c8b5a032b5a3c2c5b5465fac63f3\n] \n\n[make pending and unrevert follow transaction protocol\nBen Franksen <ben.franksen@online.de>**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 <ben.franksen@online.de>**20210303141232\n Ignore-this: bc5346f4bf3470f5189972bac38a7cbd615b2af86293448910dd4c27dcb3004667b6ceb5056bfeee\n \n This required fixing convert import where cleanRepository was called after\n finalizing the transaction.\n] \n\n[lock/unlock inside revert/finalizeRepositoryChanges\nBen Franksen <ben.franksen@online.de>**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[remove the tentative state witness parameter for Repository\nBen Franksen <ben.franksen@online.de>**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[replace readTentativePristine with the generalized readPristine\nBen Franksen <ben.franksen@online.de>**20210227101454\n Ignore-this: d9d1cf61973e9ab95dc708b373f7aadd3e272ff4165eec573ab5e1f44c12581c87c093abd3dd3407\n \n The latter now now does the right thing for both RO and RW repos.\n] \n\n[fix rt ~ 'RO in AskAboutDeps\nBen Franksen <ben.franksen@online.de>**20210301152702\n Ignore-this: a7407c6f80e3eb5875536ce8fc7a670f138961589efc005811c178f402d9526417089761c838ca6c\n] \n\n[convert D.R.Pristine to assign the correct access type parameters\nBen Franksen <ben.franksen@online.de>**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 <ben.franksen@online.de>**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 <ben.franksen@online.de>**20210225212710\n Ignore-this: c90aad2cd771f5819bf7f488282a5562d1bc7ed41884f575d757670746c6f87b398db2ce30692e8\n] \n\n[convert D.R.Hashed functions to take access typed Repository\nBen Franksen <ben.franksen@online.de>**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 <ben.franksen@online.de>**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 <ben.franksen@online.de>**20210224225716\n Ignore-this: 21347143ab31dc16399b2b1d7145f88d715d713d92a0f05c74cb6a32948c392a9aa7fe2ea2790a3a\n] \n\n[decouple IsPrimV1 from ApplyState p ~ Tree, simplify runJob\nBen Franksen <ben.franksen@online.de>**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[remove most of Darcs.Patch.RepoType\nBen Franksen <ben.franksen@online.de>**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[replace class ApplyMonadState with a top-level type family\nBen Franksen <ben.franksen@online.de>**20210403052400\n Ignore-this: 44e612123ac4c648172b7faa858c454e06202979d4786b5b995af23320de86d1fa81ebfd4e06993b\n \n The class ApplyMonadState was only there to carry the type (constraint)\n family ApplyMonadStateOperations, which I renamed to ApplyMonadOperations\n for brevity.\n] \n\n[cleanup method definitions in D.P.ApplyMonad\nBen Franksen <ben.franksen@online.de>**20210315204754\n Ignore-this: 857d05e8ebefd55ce919d8f0a5e0ee04d52f414fbb67309b7cc95502e912e260dc7300424da4d87c\n \n This removes -fno-warn-missing-methods and explicitly defines missing\n methods as undefined. The default definition of mCreateFile in terms of\n mModifyFilePS is removed. Defining a proper mCreateFile means we can remove\n the existence check from the definition of mModifyFilePS in the instance\n ApplyMonadTree (TM.TreeMonad m).\n] \n\n[remove unused RestrictedApply from D.P.ApplyMonad\nBen Franksen <ben.franksen@online.de>**20210315204621\n Ignore-this: a6baf4368bd7a8894afb559badab38c2ecb6814ff4e4867efc1967815449c2f5fa0d79dcd1590e83\n] \n\n[cleanup code layout of Darcs.Util.Tree.expandUpdate\nBen Franksen <ben.franksen@online.de>**20210429083448\n Ignore-this: 1c2fc782fbbdb3d25cd7ba394c87a8a291626d69a2c1250f9970b280d223f3c4fbe2b5d4a208694c\n] \n\n[add comment to updateHashes in convert import command\nBen Franksen <ben.franksen@online.de>**20210421114628\n Ignore-this: 296fa556cd510a9a39204cbbbfe838d8e7c694f4118b413414c9e24997a63cbb0a12ff38022553ec\n] \n\n[remove an obsolete FIXME comment\nBen Franksen <ben.franksen@online.de>**20210418155917\n Ignore-this: d02fdab017f3223ae4e01efdea2223816f9656abd3ff9d474605c71faeaeef1d1a3f234e8209b88c\n] \n\n[remove duplicate import of darcsAddMissingHashes\nBen Franksen <ben.franksen@online.de>**20210329092310\n Ignore-this: 5768fb8482f22fcc01214bd6f1dd4f465620dff4c892bc3a782bbb431b63ca8cec303e0c213e6be5\n] \n\n[rename replacePristine to writePristine\nBen Franksen <ben.franksen@online.de>**20210227104011\n Ignore-this: 1e83843b748164d7d69358dd5e5c8d068e8556d0b5eb8a6b523d1202a531affebd3f48dee734a2a9\n] \n\n[inline writePristine into the slightly safer replacePristine\nBen Franksen <ben.franksen@online.de>**20210227065632\n Ignore-this: 67be252d4074427f4eda80cdd0b32d9f1df2f6a8a0d01cb765f2f33b126348d647ae8cefcf6c3306\n] \n\n[move writePristine and replacePristine to D.R.Pristine\nBen Franksen <ben.franksen@online.de>**20210226072752\n Ignore-this: 962840dcfe69dc9c7e75d9ff594feb7e8abe592019639c5b0a4c07972124d9ec96ffcbb370fc64dd\n] \n\n[inline D.R.Pristine.withRecorded\nBen Franksen <ben.franksen@online.de>**20210225201917\n Ignore-this: fd7096445bc1ad5649531dd7d7e84c56e2282e468c1a1c1fda73fe67093deb6b28568c2af07687f2\n] \n\n[show index: print table headers\nBen Franksen <ben.franksen@online.de>**20210415095307\n Ignore-this: 18a6aa1d67b99042fcd7922a1759b1c1dc92e6c27da170da59a10eebc9ea1e68ee118098360966d7\n] \n\n[factor out delaySealed\nBen Franksen <ben.franksen@online.de>**20210406121845\n Ignore-this: 5e4c7a5105d564f61001a823034e81451711a9614220300b83a4250cede65c3b021889f04e0baa0b\n] \n\n[add debug message in applyToWorking\nBen Franksen <ben.franksen@online.de>**20210314221902\n Ignore-this: 2f292e632a8e46c65b9797da6a91d24421d2f171d68f59c8c610d3bf9a615e4341528d11080eb1e0\n] \n\n[fix the haddocks for applyToHashedPristine\nBen Franksen <ben.franksen@online.de>**20210306155542\n Ignore-this: a2b27a89532379fcfdb4475e7526e1240b62b4b8ec85825080d923fa9e438f449148e1a64c7ca17a\n] \n\n[make readPristine fail for old-fashioned repos\nBen Franksen <ben.franksen@online.de>**20201109213344\n Ignore-this: d557e21edc3aa84d8cb10d674b0dbbc6e1a6add0b2bf1e9d30affefc0986a5ea30f68435166819e2\n \n The extra code for the case of repos that aren't in hashed format is\n apparently not needed.\n] \n\n[streamline the code in the darcs main module\nBen Franksen <ben.franksen@online.de>**20210304074801\n Ignore-this: 7ae5d5397e77c6a2b29955a1ae88e9524c09e94e127ad2c7a847d3c1a0adb3d4e86ce3724b415d44\n] \n\n[cleanup Darcs.Util.AtExit\nBen Franksen <ben.franksen@online.de>**20210304073226\n Ignore-this: 728c2bda1267808f6064e2414a4d764954a5249ecc198b640585d7d5fc7595644c64d43683ac5ef3\n \n Apart from layout changes, this replaces bracket_ with finally and removes\n the extra mask/unmask stuff; the exit action of bracket/finally is executed\n in masked state anyway, so any further masking/unmasking has no effect.\n] \n\n[D.R.Traverse: cut down the list of exported symbols\nBen Franksen <ben.franksen@online.de>**20210303140603\n Ignore-this: 72471dcd6daa900dd833bb4227859730392861d84cd96cb482d485e1a42e32db8d648d9587a8a577\n] \n\n[rename withRepoLocation -> withRepoDir\nBen Franksen <ben.franksen@online.de>**20210228122604\n Ignore-this: 59f365cd4b78349051c71ee8f359d8f47e2009117284b2bbef11d9e16bad31c804d1c6e30a0fc70b\n] \n\n[fix stale lock files after Ctrl-C\nBen Franksen <ben.franksen@online.de>**20210304064825\n Ignore-this: c362c176b5248c96fa9debb939c309266825ef2b513c2d1f539e8b7f53196cd24195ad9ffd269f40\n \n This changes the order of the handlers in the main function of the darcs\n executable, so that atexit is handled earlier than signals. This should also\n have the effect of removing temporary files and directories created using\n withDelayedDir in a more reliable manner.\n \n Both handleErrors and handleExecFail are uncritical, they merely re-classify\n and annotate certain exceptions and report them in a more user friendly\n fashion, so handleExitFail was also moved out of the withSignalsHandled.\n] \n\n[move command: readPlainTree -> readUnrecordedFiltered\nBen Franksen <ben.franksen@online.de>**20210122172254\n Ignore-this: 24506233de7ee3bdf560bbb72fab7621df4d586c53f910f709169346ea90c7f114d8c0c8ff1a9b90\n \n The difference is that readUnrecordedFiltered (with the given options) uses\n the index, if possible.\n] \n\n[ci: run tests only for latest cabal and earliest & latest ghc version\nBen Franksen <ben.franksen@online.de>**20210607073645\n Ignore-this: 38f4353188f3d7b8ffeea1fd600781f171e6bbfa6a84b259689a8080db371d75c12bb542eddb3d0b\n] \n\n[remove lookFor* functions from Darcs.UI.Flags\nBen Franksen <ben.franksen@online.de>**20210605143653\n Ignore-this: 251a3321032281674e26ff2f43894286dd0ee0c1be6047a8eb9617e1f3534b2a1c6ec82fac44f9a4\n \n Two of them are unused (outside of the defining module) and they all collide\n with the members of DiffOpts.\n] \n\n[remove duplicate definition of diffingOpts\nBen Franksen <ben.franksen@online.de>**20210605143413\n Ignore-this: 9980cd2b1b010097fcaec12fe1b97bf322a864cf375ed16d000387a6190a7c4bea2e0094f18e3d8a\n] \n\n[add PatchHeaderConfig\nBen Franksen <ben.franksen@online.de>**20210303171700\n Ignore-this: 51df902f048fe1bdc32146e544ef368824677bd4a88cc4a942db0175450fa667bab2ddccfdf12c37\n \n This groups everything we get from the command options into a record type to\n cut down on the number of parameters of updatePatchHeader. Also add the\n patchname option to rebase unsuspend and re-order the options so they are\n the same as for amend.\n] \n\n[tests/network/show_tags-remote.sh: remove directories\nBen Franksen <ben.franksen@online.de>**20210529153906\n Ignore-this: 4cb6240ee582a069e97478e207041769cbfa27c7674d1ecfa4630926a1cfae43977824a7bd6b58f\n] \n\n[tests for issue1327 and issue2047 fail only for darcs-1 and darcs-2\nBen Franksen <ben.franksen@online.de>**20210527165230\n Ignore-this: aa267cc3017b9d1eea875ff61adfbf9aa4920cdc1cdd5a8f0dc8bb7e6c5f000b1b927bb6c1edf488\n] \n\n[test for issue1579 no longer fails\nBen Franksen <ben.franksen@online.de>**20210527164014\n Ignore-this: 64bba9cb049c4ba78c7977145efbb5ac1f11e1522f4e19e6a1486ffbe18fb5e58da0c72a3f114cfa\n] \n\n[tests: mark issue1014 as no longer failing\nBen Franksen <ben.franksen@online.de>**20210527161920\n Ignore-this: 47d001eef87c89766407280be02af23afa1c6cb357dbf8c5d4ad97c182ee89231b7650167c69d0d5\n \n After fixing a few minor issues in the test script, this test succeeds for\n darcs-3 as that fixes the underlying issue. However, the test script needed\n a few minor fixes to actually fail for the right reason. In particular,\n cloning a conflicted repo nowadays applies conflict markup, which we have to\n revert before pulling, otherwise we get prompted and the test fails with\n \"promptChar: unexpected end of input\".\n] \n\n[remove overspecification of pending from tests\nBen Franksen <ben.franksen@online.de>**20210324072532\n Ignore-this: 3ce02680e19fd8e30aad4ecc0fb69585cce303e3cbb780c5d9a83f81b2b7bccecc086b0bbce92c5e\n \n The test scripts should not prescribe the concrete format of the pending\n patch, not even an empty one.\n] \n\n[harness: run test-framework with explicit RunnerOptions\nBen Franksen <ben.franksen@online.de>**20210303110226\n Ignore-this: 11651f3e41ad325e9608b2c367a866012616f6a58187b2425008932d87188daec3f3ffdfd4a50a17\n] \n\n[rebase unsuspend: add more patch editing options\nBen Franksen <ben.franksen@online.de>**20210302213552\n Ignore-this: 9173186fbc49dac677ded69fbddf52ff20b22d0c013207f3616fcb917cf915ba05864fe93965ae8\n \n These require no extra code, they are handled by updatePatchHeader.\n] \n\n[obliterate, rebase suspend: pass NoUpdatePending to tentativelyRemovePatches\nBen Franksen <ben.franksen@online.de>**20210302131340\n Ignore-this: 4f35536d5091c3c9cb671a380fa72156330b46cf9ea6ef7bb767b29e182c783af047c9e8cb5b3609\n \n This avoids the redundant use of the (unsafe) tentativelyAddToPending to\n remove what gets added to pending with YesUpdatePending.\n] \n\n[use path definitions from D.R.Paths in a few more places\nBen Franksen <ben.franksen@online.de>**20210227061118\n Ignore-this: 203551b945fc2af5c4eef5a6a6ac5de0f582e919bbfda840bae8b989dc993abb28e17fcdc8404d16\n] \n\n[remove some outdated or otherwise unfortunate comments\nBen Franksen <ben.franksen@online.de>**20210305061108\n Ignore-this: 1196b6fc176f6676db204d6ee9698cf342a7994a8d1804a777e3117a0b76015fefbb4e5a4df81184\n \n The \"otherwise unfortunate\" refers to mentions of repository file paths;\n these will become outdated if we make changes to them.\n] \n\n[use paths from D.R.Paths in D.R.Packs\nBen Franksen <ben.franksen@online.de>**20201108125712\n Ignore-this: 749668dc014f43ac07a19da7465a199285a4481f5ac8daa289e576a30c1399c938e76d3e1eb4cdc3\n \n This also removes an obsolete debugMessage and then inlines\n fetchFilesUsingCache.\n] \n\n[remove UpdatePending parameter to withRepoLock\nBen Franksen <ben.franksen@online.de>**20210122173346\n Ignore-this: c3bde2b310554f26a98d38f6cf97a0c75988b45429a4d16c53f694feb7b62e2c550f71d03a0b5280\n \n It turned out that we always call that procedure with YesUpdatePending, so\n we can as well hard-code it.\n] \n\n[simplify readPatchesUsingSpecificInventory\nBen Franksen <ben.franksen@online.de>**20201223204234\n Ignore-this: a73c7d343c1310e1aacb5d52c439efd3b9a97f7409a670b0e099fb532c60c74d6eececf8abdaf11b\n] \n\n[move revert/finalize of rebase from D.R.Hashed to D.R.Rebase\nBen Franksen <ben.franksen@online.de>**20210224124453\n Ignore-this: 84d15717486d2bc4ea795d024515aa2a339476c2f0cc9943024d761e588d871bde505ad1171ed60a\n] \n\n[in fetchFileLazyPS also check for URI scheme \"https:\"\nBen Franksen <ben.franksen@online.de>**20210525125416\n Ignore-this: 5606ea6f55be3edca3a7ee4507947095352692bd00b61fa15a7a4fb10b8031dd3b91fe430f9d9521\n] \n\n[D.R.Hashed: make debug messages less verbose\nBen Franksen <ben.franksen@online.de>**20210529152703\n Ignore-this: 181e110cf105cb1e25c525420522394bdff0cd604befa27ee4818c335f08139a974096c9a8d66416\n \n The patch name should be sufficient to see which patch is being read.\n] \n\n[Darcs.Util.SignalHandler: replace throw with throwIO\nBen Franksen <ben.franksen@online.de>**20210602203613\n Ignore-this: 933bfdeb1e297e6a62beadd3362607aa7cbae9562cd169cfb85e95a0088d5a9c1001f9e90c1ae716\n] \n\n[Darcs.Util.ByteString: avoid throwing exceptions from pure code\nBen Franksen <ben.franksen@online.de>**20210602203401\n Ignore-this: e6dbe87e1dace4fbe3aa386dd9fbb8d097576f460fda5ce5eb60781a8276a2e22f89b8530b4bd8b1\n] \n\n[Windows build fix in Darcs.UI.External\nGanesh Sittampalam <ganesh@earth.li>**20210603170522\n Ignore-this: 48da742c87f9e281dd7bb4adb95cf7ca3dd0c7f2b5ed301c72703e8699186f8f5a713d8a98695e64\n] \n\n[TAG 2.17.1\nBen Franksen <ben.franksen@online.de>**20210603145935\n Ignore-this: 78fb3abbe5aaee753f99906467c1fafcd15573995d5878e6d8613762190276de8dfed8cbbcbc0c68\n] \n"
\ No newline at end of file
diff --git a/release/distributed-version b/release/distributed-version
index edf29312..1e5cc6ba 100644
--- a/release/distributed-version
+++ b/release/distributed-version
@@ -1 +1 @@
-Just 21
\ No newline at end of file
+Just 113
\ No newline at end of file
diff --git a/src/Darcs/Patch.hs b/src/Darcs/Patch.hs
index 622beb2e..1a2c88b8 100644
--- a/src/Darcs/Patch.hs
+++ b/src/Darcs/Patch.hs
@@ -32,9 +32,7 @@ module Darcs.Patch
     , binary
     , description
     , showPatchWithContext
-    , ShowPatchFor(..)
     , showPatch
-    , displayPatch
     , content
     , infopatch
     , changepref
@@ -56,6 +54,8 @@ module Darcs.Patch
     , commuteFL
     , commuteRL
     , readPatch
+    , readPatchFL
+    , formatPatch
     , readPatchPartial
     , canonizeFL
     , sortCoalesceFL
@@ -86,6 +86,7 @@ import Darcs.Patch.Apply ( apply, effectOnPaths, applyToTree,
 import Darcs.Patch.Commute ( commute, commuteFL, commuteRL )
 import Darcs.Patch.Conflict ( resolveConflicts )
 import Darcs.Patch.Effect ( Effect(effect) )
+import Darcs.Patch.Format ( formatPatch )
 import Darcs.Patch.Invert ( invert, invertRL, invertFL )
 import Darcs.Patch.Inspect ( listTouchedFiles, hunkMatches )
 import Darcs.Patch.Merge ( merge )
@@ -102,11 +103,11 @@ import Darcs.Patch.Prim ( canonizeFL,
                           binary, changepref, hunk, move,
                           tryToShrink,
                           PrimPatch )
-import Darcs.Patch.Read ( readPatch, readPatchPartial )
+import Darcs.Patch.Read ( readPatch, readPatchFL, readPatchPartial )
 import Darcs.Patch.Repair ( isInconsistent )
 import Darcs.Patch.RepoPatch ( RepoPatch )
-import Darcs.Patch.Show ( description, showPatch, content, displayPatch
-                        , summary, summaryFL, thing, things, ShowPatchFor(..)
+import Darcs.Patch.Show ( description, showPatch, content
+                        , summary, summaryFL, thing, things
                         , showPatchWithContext )
 import Darcs.Patch.Summary
     ( listConflictedFiles
diff --git a/src/Darcs/Patch/Annotate.hs b/src/Darcs/Patch/Annotate.hs
index ff79a1f5..b4985754 100644
--- a/src/Darcs/Patch/Annotate.hs
+++ b/src/Darcs/Patch/Annotate.hs
@@ -63,7 +63,7 @@ import qualified Darcs.Patch.Prim.FileUUID as FileUUID
 import Darcs.Patch.Annotate.Class
 import Darcs.Patch.Effect ( Effect(..) )
 import Darcs.Patch.FromPrim ( PrimOf )
-import Darcs.Patch.Info ( displayPatchInfo, piAuthor, makePatchname )
+import Darcs.Patch.Info ( showPatchInfo, piAuthor, makePatchname )
 import Darcs.Patch.Invert ( Invert, invert )
 import Darcs.Patch.Named ( patchcontents )
 import Darcs.Patch.PatchInfoAnd( info, PatchInfoAnd, hopefully )
@@ -232,7 +232,7 @@ format d a = pi_list ++ "\n" ++ numbered
 
     numbered = unlines . map prependNum $ numberedLines
 
-    pi_list = unlines [ show n ++ ": " ++ renderString (displayPatchInfo i)
+    pi_list = unlines [ show n ++ ": " ++ renderString (showPatchInfo i)
                       | (n :: Int, i) <- zip [1..] pis ]
 
     file = concat [ annotation (fst $ NE.head chunk) ++ " | " ++ line (NE.head chunk) ++
diff --git a/src/Darcs/Patch/Bracketed.hs b/src/Darcs/Patch/Bracketed.hs
index aa35b6f6..0e5c197d 100644
--- a/src/Darcs/Patch/Bracketed.hs
+++ b/src/Darcs/Patch/Bracketed.hs
@@ -5,10 +5,9 @@ module Darcs.Patch.Bracketed
 
 import Darcs.Prelude
 
-import Darcs.Patch.Format ( PatchListFormat )
-import Darcs.Patch.Show ( ShowPatchBasic(..) )
+import Darcs.Patch.Format ( FormatPatch(..) )
 import Darcs.Patch.Witnesses.Ordered ( FL(..), mapFL, mapFL_FL, concatFL )
-import Darcs.Util.Printer ( vcat, blueText, ($$) )
+import Darcs.Util.Format ( vcat, ascii, ($$) )
 
 
 -- |This type exists for legacy support of on-disk format patch formats.
@@ -40,14 +39,11 @@ mapBracketed f (Parens ps) = Parens (mapBracketedFLFL f ps)
 mapBracketedFLFL :: (forall wA wB . p wA wB -> q wA wB) -> BracketedFL p wX wY -> BracketedFL q wX wY
 mapBracketedFLFL f = mapFL_FL (mapBracketed f)
 
-instance PatchListFormat (Bracketed p)
+instance FormatPatch p => FormatPatch (Bracketed p) where
+  formatPatch (Singleton p) = formatPatch p
+  formatPatch (Braced NilFL) = ascii "{" $$ ascii "}"
+  formatPatch (Braced ps) = ascii "{" $$ vcat (mapFL formatPatch ps) $$ ascii "}"
+  formatPatch (Parens ps) = ascii "(" $$ vcat (mapFL formatPatch ps) $$ ascii ")"
 
-instance ShowPatchBasic p => ShowPatchBasic (Bracketed p) where
-    showPatch f (Singleton p) = showPatch f p
-    showPatch _ (Braced NilFL) = blueText "{" $$ blueText "}"
-    showPatch f (Braced ps) = blueText "{" $$ vcat (mapFL (showPatch f) ps) $$ blueText "}"
-    showPatch f (Parens ps) = blueText "(" $$ vcat (mapFL (showPatch f) ps) $$ blueText ")"
-
--- the ReadPatch instance is defined in Darcs.Patch.Read as it is
--- used as an intermediate form during reading of lists of patches
--- that are specified as ListFormatV1 or ListFormatV2.
+-- The ReadPatch instance is defined in Darcs.Patch.Read as it is used as an
+-- intermediate form during reading of lists of patches in legacy formats.
diff --git a/src/Darcs/Patch/Bundle.hs b/src/Darcs/Patch/Bundle.hs
index ac4d6809..036b3056 100644
--- a/src/Darcs/Patch/Bundle.hs
+++ b/src/Darcs/Patch/Bundle.hs
@@ -43,39 +43,33 @@ import qualified Data.ByteString.Char8 as BC
     , pack
     )
 
-import Darcs.Patch.Apply ( ApplyState, ObjectIdOfPatch )
-import Darcs.Patch.ApplyMonad ( ApplyMonadTrans )
 import Darcs.Patch.Bracketed ( Bracketed, unBracketedFL )
 import Darcs.Patch.Commute ( Commute, commuteFL )
 import Darcs.Patch.Depends ( contextPatches, splitOnTag )
-import Darcs.Patch.Format ( PatchListFormat )
+import Darcs.Patch.Format ( FormatPatch(..) )
 import Darcs.Patch.Info
     ( PatchInfo
-    , displayPatchInfo
+    , showPatchInfo
     , piTag
     , readPatchInfo
-    , showPatchInfo
+    , formatPatchInfo
     )
 import Darcs.Patch.Named ( Named, fmapFL_Named )
-import Darcs.Patch.Object ( ObjectId )
 import Darcs.Patch.PatchInfoAnd
     ( PatchInfoAnd
     , info
     , n2pia
-    , patchInfoAndPatch
     , unavailable
     )
 import Darcs.Patch.Permutations ( genCommuteWhatWeCanRL )
-import Darcs.Patch.Read ( readPatch' )
+import Darcs.Patch.Read ( readPatchFL' )
 import Darcs.Patch.RepoPatch ( RepoPatch )
-import Darcs.Patch.Show ( showPatch, showPatchWithContext )
 import Darcs.Patch.Set
     ( PatchSet(..)
     , SealedPatchSet
     , Origin
     , appendPSFL
     )
-import Darcs.Patch.Show ( ShowPatchBasic, ShowPatchFor(ForStorage) )
 import Darcs.Patch.Witnesses.Ordered
     ( (:>)(..)
     , FL(..)
@@ -93,26 +87,20 @@ import Darcs.Util.ByteString
     , mmapFilePS
     , betweenLinesPS
     )
-import Darcs.Util.Hash ( sha1PS, sha1Show )
-import Darcs.Util.Parser
-    ( Parser
-    , lexString
-    , lexWord
-    , optional
-    , parse
-    )
-import Darcs.Util.Printer
-    ( Doc
-    , ($$)
+import Darcs.Util.Format
+    ( Format
+    , ascii
+    , byteString
     , newline
-    , packedString
-    , renderPS
-    , renderString
-    , text
+    , protect
+    , toLazyByteString
     , vcat
     , vsep
+    , ($$)
     )
-
+import Darcs.Util.Hash ( sha1, sha1Show )
+import Darcs.Util.Parser ( Parser, lexString, lexWord, optional, parse )
+import Darcs.Util.Printer ( renderString )
 
 -- | A 'Bundle' is a context together with some patches. The context
 -- consists of unavailable patches.
@@ -133,37 +121,28 @@ interpretBundle ref (Bundle (context :> patches)) =
 -- | Create a b16 encoded SHA1 of a given a FL of named patches. This allows us
 -- to ensure that the patches in a received bundle have not been modified in
 -- transit.
-hashBundle :: (PatchListFormat p, ShowPatchBasic p) => FL (Named p) wX wY
-           -> B.ByteString
+hashBundle :: FormatPatch p => FL (Named p) wX wY -> B.ByteString
 hashBundle to_be_sent =
-    sha1Show $ sha1PS $ renderPS $
-        vcat (mapFL (showPatch ForStorage) to_be_sent) <> newline
+    sha1Show $ sha1 $ toLazyByteString $
+        vcat (mapFL formatPatch to_be_sent) <> newline
 
-makeBundle
-  :: (RepoPatch p, ApplyMonadTrans (ApplyState p) IO, ObjectId (ObjectIdOfPatch p))
-  => Maybe (ApplyState p IO)
-  -> PatchSet p wStart wX
-  -> FL (Named p) wX wY
-  -> IO Doc
-makeBundle mstate repo to_be_sent
-  | _ :> context <- contextPatches repo =
-    format context <$>
-      case mstate of
-        Just state -> showPatchWithContext ForStorage state to_be_sent
-        Nothing -> return (vsep $ mapFL (showPatch ForStorage) to_be_sent)
+makeBundle :: RepoPatch p => PatchSet p wStart wX -> FL (Named p) wX wY -> Format
+makeBundle repo to_be_sent =
+  case contextPatches repo of
+    _ :> context -> format context $ vsep $ mapFL formatPatch to_be_sent
   where
     format context patches =
-      text ""
-      $$ text "New patches:"
-      $$ text ""
+      protect (ascii "")
+      $$ ascii "New patches:"
+      $$ protect (ascii "")
       $$ patches
-      $$ text ""
-      $$ text "Context:"
-      $$ text ""
-      $$ vcat (mapRL (showPatchInfo ForStorage . info) context)
-      $$ text "Patch bundle hash:"
-      $$ packedString (hashBundle to_be_sent)
-      $$ text ""
+      $$ protect (ascii "")
+      $$ ascii "Context:"
+      $$ protect (ascii "")
+      $$ vcat (mapRL (formatPatchInfo . info) context)
+      $$ ascii "Patch bundle hash:"
+      $$ byteString (hashBundle to_be_sent)
+      $$ protect (ascii "")
 
 hashFailureMessage :: String
 hashFailureMessage =
@@ -215,8 +194,8 @@ bundleHashName = BC.pack "Patch bundle hash:"
 unavailablePatchesFL :: [PatchInfo] -> FL (PatchInfoAnd p) wX wY
 unavailablePatchesFL = foldr ((:>:) . piUnavailable) (unsafeCoercePEnd NilFL)
   where
-    piUnavailable i = patchInfoAndPatch i . unavailable $
-      "Patch not stored in patch bundle:\n" ++ renderString (displayPatchInfo i)
+    piUnavailable i = unavailable i $
+      "Patch not stored in patch bundle:\n" ++ renderString (showPatchInfo i)
 
 pContext :: Parser [PatchInfo]
 pContext = lexString contextName >> many readPatchInfo
@@ -225,7 +204,7 @@ contextName :: B.ByteString
 contextName = BC.pack "Context:"
 
 pPatches :: RepoPatch p => Parser (Sealed (FL (Named (Bracketed p)) wX))
-pPatches = lexString patchesName >> readPatch'
+pPatches = lexString patchesName >> readPatchFL'
 
 patchesName :: B.ByteString
 patchesName = BC.pack "New patches:"
diff --git a/src/Darcs/Patch/Conflict.hs b/src/Darcs/Patch/Conflict.hs
index e4c0c684..cd71edec 100644
--- a/src/Darcs/Patch/Conflict.hs
+++ b/src/Darcs/Patch/Conflict.hs
@@ -18,7 +18,7 @@ import Darcs.Patch.CommuteNoConflicts ( CommuteNoConflicts(..) )
 import Darcs.Patch.Permutations ()
 import Darcs.Patch.FromPrim ( PrimOf )
 import Darcs.Patch.Prim ( PrimMangleUnravelled(..), Mangled, Unravelled )
-import Darcs.Patch.Show ( ShowPatch(..), ShowPatchFor(ForStorage), showPatch )
+import Darcs.Patch.Show ( ShowPatch(..), showPatch )
 import Darcs.Patch.Witnesses.Ordered ( (:>)(..), FL(..), RL(..), mapFL, (+<<+) )
 import Darcs.Util.Printer ( renderString, text, vcat, ($$) )
 
@@ -105,11 +105,11 @@ findConflicting context patch = go (context :> NilFL :> patch :> NilFL) where
     | not (isConflicted p) = prune (ctx +<<+ deps :> p :> NilRL :> nondeps)
   go (NilRL :> deps :> p :> nondeps) =
     error $ renderString $ text "precondition violated:" $$
-      vcat (mapFL (showPatch ForStorage) deps) $$
+      vcat (mapFL showPatch deps) $$
       text "===============" $$
-      text "patch:" $$ (showPatch ForStorage) p $$
+      text "patch:" $$ showPatch p $$
       text "===============" $$
-      vcat (mapFL (showPatch ForStorage) nondeps)
+      vcat (mapFL showPatch nondeps)
   go (cs :<: c :> deps :> p :> nondeps) =
     case commuteFL (c :> deps) of
       Nothing -> go (cs :> c :>: deps :> p :> nondeps)
diff --git a/src/Darcs/Patch/Depends.hs b/src/Darcs/Patch/Depends.hs
index 68228095..41dce001 100644
--- a/src/Darcs/Patch/Depends.hs
+++ b/src/Darcs/Patch/Depends.hs
@@ -80,6 +80,7 @@ import Darcs.Patch.Set
     , patchSet2FL
     , patchSet2RL
     , patchSetSplit
+    , unwrapOneTagged
     )
 import Darcs.Patch.Progress ( progressRL )
 import Darcs.Patch.Witnesses.Unsafe ( unsafeCoercePStart )
@@ -234,13 +235,6 @@ makeClean (PatchSet ts ps) t =
         else Nothing
     _ -> error "imposible"
 
--- |'unwrapOneTagged' unfolds a single Tagged object in a PatchSet, adding the
--- tag and patches to the PatchSet's patch list.
-unwrapOneTagged :: PatchSet p wX wY -> Maybe (PatchSet p wX wY)
-unwrapOneTagged (PatchSet (ts :<: Tagged tps t _) ps) =
-    Just $ PatchSet ts (tps :<: t +<+ ps)
-unwrapOneTagged _ = Nothing
-
 -- | Return the 'PatchInfo' for all the patches in a 'PatchSet' that are not
 -- *explicitly* depended on by any tag (in the given 'PatchSet').
 --
diff --git a/src/Darcs/Patch/FileHunk.hs b/src/Darcs/Patch/FileHunk.hs
index 895e749a..9cac321d 100644
--- a/src/Darcs/Patch/FileHunk.hs
+++ b/src/Darcs/Patch/FileHunk.hs
@@ -6,43 +6,56 @@ module Darcs.Patch.FileHunk
 import Darcs.Prelude
 
 import Darcs.Patch.Apply ( ObjectIdOfPatch )
-import Darcs.Patch.Format ( FileNameFormat )
 import Darcs.Patch.Invert ( Invert(..) )
 import Darcs.Patch.Object ( ObjectId(..) )
 
 import Darcs.Util.Printer
-    ( Doc, blueText, text, lineColor, vcat, userchunkPS
+    ( Print(..), Doc, blueText, text, lineColor, vcat, userchunkPS
     , prefix, ($$), (<+>), Color(Cyan, Magenta) )
 
 import qualified Data.ByteString as B ( ByteString )
 
 
-data FileHunk oid wX wY = FileHunk oid !Int [B.ByteString] [B.ByteString]
+data FileHunk xd oid wX wY = FileHunk xd oid !Int [B.ByteString] [B.ByteString]
 
-type role FileHunk nominal nominal nominal
+type role FileHunk nominal nominal nominal nominal
 
-class IsHunk p where
-    isHunk :: p wX wY -> Maybe (FileHunk (ObjectIdOfPatch p) wX wY)
+class Print (ExtraData p) => IsHunk p where
+  type ExtraData p
+  isHunk :: p wX wY -> Maybe (FileHunk (ExtraData p) (ObjectIdOfPatch p) wX wY)
+  fromHunk :: FileHunk (ExtraData p) (ObjectIdOfPatch p) wX wY -> p wX wY
 
-showFileHunk :: ObjectId oid => FileNameFormat -> FileHunk oid wX wY -> Doc
-showFileHunk x (FileHunk f line old new) =
-           blueText "hunk" <+> formatObjectId x f <+> text (show line)
-        $$ lineColor Magenta (prefix "-" (vcat $ map userchunkPS old))
-        $$ lineColor Cyan    (prefix "+" (vcat $ map userchunkPS new))
+showFileHunkHeader
+  :: (ObjectId oid, Print xd) => xd -> oid -> Int -> Doc
+showFileHunkHeader xd oid line =
+  print xd $$
+  blueText "hunk" <+> showObjectId oid <+> text (show line)
+
+showFileHunkBody :: [B.ByteString] -> [B.ByteString] -> Doc
+showFileHunkBody old new =
+  lineColor Magenta (prefix "-" (vcat $ map userchunkPS old)) $$
+  lineColor Cyan (prefix "+" (vcat $ map userchunkPS new))
+
+showFileHunk
+  :: (ObjectId oid, Print xd) => FileHunk xd oid wX wY -> Doc
+showFileHunk (FileHunk xd oid line old new) =
+  showFileHunkHeader xd oid line $$
+  showFileHunkBody old new
 
 showContextFileHunk
-  :: ObjectId oid
-  => FileNameFormat
-  -> [B.ByteString]
-  -> FileHunk oid wB wC
+  :: (ObjectId oid, Print xd)
+  => [B.ByteString]
+  -> FileHunk xd oid wB wC
   -> [B.ByteString]
   -> Doc
-showContextFileHunk fmt pre (FileHunk f l o n) post =
-  blueText "hunk" <+> formatObjectId fmt f <+> text (show l) $$
+showContextFileHunk pre (FileHunk xd oid line old new) post =
+  showFileHunkHeader xd oid line $$
   prefix " " (vcat $ map userchunkPS pre) $$
-  lineColor Magenta (prefix "-" (vcat $ map userchunkPS o)) $$
-  lineColor Cyan (prefix "+" (vcat $ map userchunkPS n)) $$
+  showFileHunkBody old new $$
   prefix " " (vcat $ map userchunkPS post)
 
-instance Invert (FileHunk oid) where
-    invert (FileHunk path line old new) = FileHunk path line new old
+-- NOTE This instance is for low-level prim patch manipulation, such as done in
+-- Darcs.Patch.Prim.V1.Mangle or Darcs.Patch.Split, which is why we retain the
+-- ExtraData as is and don't require a capability to invert it.
+instance Invert (FileHunk xd oid) where
+  invert (FileHunk xd path line old new) = FileHunk xd path line new old
diff --git a/src/Darcs/Patch/Format.hs b/src/Darcs/Patch/Format.hs
index 991d29a1..437f3300 100644
--- a/src/Darcs/Patch/Format.hs
+++ b/src/Darcs/Patch/Format.hs
@@ -1,39 +1,13 @@
 module Darcs.Patch.Format
-    ( PatchListFormat(..)
-    , ListFormat(..)
-    , FileNameFormat(..)
+    ( FormatPatch(..)
     ) where
 
-import Darcs.Prelude
+import Darcs.Patch.Witnesses.Ordered ( FL(..), mapFL )
+import Darcs.Util.Format ( Format, vcat )
 
--- | Showing and reading lists of patches. This class allows us to control how
--- lists of patches are formatted on disk. For legacy reasons V1 patches have
--- their own special treatment (see 'ListFormat'). Other patch types use the
--- default format which just puts them in a sequence without separators or any
--- prelude/epilogue.
---
--- This means that 'FL (FL p)' etc would be ambiguous, so there are no
--- instances for 'FL p' or other list types.
-class PatchListFormat p where
-    patchListFormat :: ListFormat p
-    patchListFormat = ListFormatDefault
-
--- | This type is used to tweak the way that lists of 'p' are shown for a given
--- 'Patch' type 'p'. It is needed to maintain backwards compatibility for V1
--- and V2 patches.
-data ListFormat (p :: Type -> Type -> Type)
-    = ListFormatDefault -- ^ Show and read lists without braces.
-    | ListFormatV1      -- ^ Show lists with a single layer of braces around
-                        -- the outside, except for singletons which have no
-                        -- braces. Read with arbitrary nested braces and parens
-                        -- and flatten them out.
-    | ListFormatV2      -- ^ Show lists without braces. Read with arbitrary
-                        -- nested parens and flatten them out.
-    | ListFormatV3      -- ^ Temporary hack to disable use of showContextSeries
-                        -- for darcs-3 patches, until I find out how to fix this.
-
-data FileNameFormat
-    = FileNameFormatV1      -- ^ on-disk format for V1 patches
-    | FileNameFormatV2      -- ^ on-disk format for V2 patches
-    | FileNameFormatDisplay -- ^ display format
-    deriving (Eq, Show)
+class FormatPatch p where
+  formatPatch :: p wX wY -> Format
+  -- | Part of the class so we can override formatting of patch lists
+  -- for individual instances (to support legacy formats)
+  formatPatchFL :: FL p wX wY -> Format
+  formatPatchFL ps = vcat (mapFL formatPatch ps)
diff --git a/src/Darcs/Patch/Ident.hs b/src/Darcs/Patch/Ident.hs
index 5d73972f..9e456204 100644
--- a/src/Darcs/Patch/Ident.hs
+++ b/src/Darcs/Patch/Ident.hs
@@ -27,7 +27,6 @@ import Darcs.Prelude
 
 import Darcs.Patch.Commute ( Commute, commute, commuteFL, commuteRL )
 import Darcs.Patch.Permutations ( partitionFL', partitionRL' )
-import Darcs.Patch.Show ( ShowPatchFor )
 import Darcs.Patch.Witnesses.Eq ( Eq2(..), EqCheck(..), isIsEq )
 import Darcs.Patch.Witnesses.Ordered
     ( (:>)(..)
@@ -44,6 +43,7 @@ import Darcs.Patch.Witnesses.Ordered
     )
 import Darcs.Patch.Witnesses.Unsafe ( unsafeCoercePEnd, unsafeCoercePStart )
 
+import Darcs.Util.Format ( Format )
 import Darcs.Util.Parser ( Parser )
 import Darcs.Util.Printer ( Doc )
 
@@ -167,7 +167,8 @@ prop> 'parse' 'readId' . 'renderPS' . 'showId' 'ForStorage' == 'id'
 -}
 class StorableId a where
   readId :: Parser a
-  showId :: ShowPatchFor -> a -> Doc
+  showId :: a -> Doc
+  formatId :: a -> Format
 
 {-# INLINABLE fastRemoveFL #-}
 -- | Remove a patch from an FL of patches with an identity. The result is
diff --git a/src/Darcs/Patch/Info.hs b/src/Darcs/Patch/Info.hs
index 8a56ecc2..f6a21ef3 100644
--- a/src/Darcs/Patch/Info.hs
+++ b/src/Darcs/Patch/Info.hs
@@ -15,18 +15,17 @@
 -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 -- Boston, MA 02110-1301, USA.
 
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
 module Darcs.Patch.Info
     ( PatchInfo(..) -- constructor and fields exported *only for tests*
     , rawPatchInfo  -- exported *only for tests*
     , patchinfo
-    , addJunk
     , replaceJunk
     , makePatchname
     , readPatchInfo
     , justName
     , justAuthor
     , justLog
-    , displayPatchInfo
     , toXml
     , toXmlShort
     , piDate
@@ -37,6 +36,7 @@ module Darcs.Patch.Info
     , piTag
     , piLog
     , showPatchInfo
+    , formatPatchInfo
     , isTag
     , escapeXML
     , validDate
@@ -49,44 +49,55 @@ module Darcs.Patch.Info
 
 import Darcs.Prelude
 
-import Data.Char ( isAscii )
+import Control.Monad ( unless, void, when )
 import Crypto.Random ( seedNew, seedToInteger )
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Short as BS
+import Data.Char ( isAscii )
+import Data.List ( isPrefixOf )
+import Data.List.NonEmpty ( NonEmpty(..) )
+import qualified Data.List.NonEmpty as NE
+import Data.String ( fromString )
 import Numeric ( showHex )
-import Control.Monad ( when, unless, void )
+import System.IO.Unsafe ( unsafePerformIO )
+import System.Time
+    ( CalendarTime
+    , calendarTimeToString
+    , toCalendarTime
+    , toClockTime
+    )
+import qualified Text.XML.Light as XML
 
+import Darcs.Test.TestOnly ( TestOnly )
 import Darcs.Util.ByteString
     ( decodeLocale
     , packStringToUTF8
     , unpackPSFromUTF8
     )
-import qualified Darcs.Util.Parser as RM ( take )
-import Darcs.Util.Parser as RM ( skipSpace, char,
-                                      takeTill, anyChar, Parser,
-                                      option,
-                                      takeTillChar,
-                                      linesStartingWithEndingWith)
-import Darcs.Patch.Show ( ShowPatchFor(..) )
-import qualified Data.ByteString       as B  (length, splitAt
-                                             ,isPrefixOf, concat
-                                             ,ByteString )
-import qualified Data.ByteString.Char8 as BC
-    ( index, notElem, all, unpack, pack )
-import Data.List( isPrefixOf )
-import Data.List.NonEmpty ( NonEmpty(..) )
-import qualified Data.List.NonEmpty as NE
-import qualified Text.XML.Light as XML
-
-import Darcs.Util.Printer ( Doc, packedString,
-                 empty, ($$), (<+>), vcat, text, cyanText, blueText )
+import Darcs.Util.Hash ( SHA1, sha1PS )
 import Darcs.Util.IsoDate ( readUTCDate )
-import System.Time ( CalendarTime, calendarTimeToString, toClockTime,
-                     toCalendarTime )
-import System.IO.Unsafe ( unsafePerformIO )
-import Darcs.Util.Hash ( sha1PS, SHA1 )
+import Darcs.Util.Parser
+    ( Parser
+    , anyChar
+    , char
+    , linesStartingWithEndingWith
+    , option
+    , skipSpace
+    , takeTill
+    , takeTillChar
+    )
+import qualified Darcs.Util.Parser as RM ( take )
+import Darcs.Util.Printer
+    ( Doc
+    , cyanText
+    , text
+    , vcat
+    , ($$)
+    , (<+>)
+    )
+import qualified Darcs.Util.Format as F
 import Darcs.Util.Prompt ( promptYorn )
 
-import Darcs.Test.TestOnly ( TestOnly )
-
 {- |
 A PatchInfo value contains the metadata of a patch. The date, name, author
 and log fields are UTF-8 encoded text in darcs 2.4 and later, and just
@@ -136,10 +147,10 @@ confusion when reading a patch from disk. Within the codebase they
 serve completely different purposes and should not interact at all.
 -}
 data PatchInfo =
-  PatchInfo { _piDate    :: !B.ByteString
-            , _piName    :: !B.ByteString
-            , _piAuthor  :: !B.ByteString
-            , _piLog     :: ![B.ByteString]
+  PatchInfo { _piDate    :: !BS.ShortByteString
+            , _piName    :: !BS.ShortByteString
+            , _piAuthor  :: !BS.ShortByteString
+            , _piLog     :: ![BS.ShortByteString]
               -- | See the long description of this field in the
               -- docs above.
             , _piLegacyIsInverted :: !Bool
@@ -154,8 +165,8 @@ data PatchInfo =
 validDate :: String -> Bool
 validDate = all validCharForDate
 
-validDatePS :: B.ByteString -> Bool
-validDatePS = BC.all validCharForDate
+validDatePS :: BS.ShortByteString -> Bool
+validDatePS = BC.all validCharForDate . BS.fromShort
 
 -- | The isAscii limitation is due to the use of BC.pack below.
 validCharForDate :: Char -> Bool
@@ -164,14 +175,14 @@ validCharForDate c = isAscii c && c /= '\n' && c /= ']'
 validLog :: String -> Bool
 validLog = notElem '\n'
 
-validLogPS :: B.ByteString -> Bool
-validLogPS = BC.notElem '\n'
+validLogPS :: BS.ShortByteString -> Bool
+validLogPS = BC.notElem '\n' . BS.fromShort
 
 validAuthor :: String -> Bool
 validAuthor = notElem '*'
 
-validAuthorPS :: B.ByteString -> Bool
-validAuthorPS = BC.notElem '*'
+validAuthorPS :: BS.ShortByteString -> Bool
+validAuthorPS = BC.notElem '*' . BS.fromShort
 
 rawPatchInfo
   :: TestOnly
@@ -180,10 +191,10 @@ rawPatchInfo = rawPatchInfoInternal
 
 rawPatchInfoInternal :: String -> String -> String -> [String] -> Bool -> PatchInfo
 rawPatchInfoInternal date name author log inverted =
-    PatchInfo { _piDate     = BC.pack $ validateDate date
-              , _piName     = packStringToUTF8 $ validateName name
-              , _piAuthor   = packStringToUTF8 $ validateAuthor author
-              , _piLog      = map (packStringToUTF8 . validateLog) log
+    PatchInfo { _piDate     = fromString $ validateDate date
+              , _piName     = BS.toShort $ packStringToUTF8 $ validateName name
+              , _piAuthor   = BS.toShort $ packStringToUTF8 $ validateAuthor author
+              , _piLog      = map (BS.toShort . packStringToUTF8 . validateLog) log
               , _piLegacyIsInverted  = inverted
               }
   where
@@ -213,8 +224,9 @@ addJunk pinf =
                           "will not be shown when displaying a patch."
                confirmed <- promptYorn "Proceed? "
                unless confirmed $ fail "User cancelled because of Ignore-this."
-       return $ pinf { _piLog = BC.pack (NE.head ignored++showHex x ""):
-                                 _piLog pinf }
+       return $
+          pinf
+            { _piLog = NE.head ignored <> (fromString $ showHex x "") : _piLog pinf }
 
 replaceJunk :: PatchInfo -> IO PatchInfo
 replaceJunk pi@(PatchInfo {_piLog=log}) = addJunk $ pi{_piLog = ignoreJunk log}
@@ -222,13 +234,13 @@ replaceJunk pi@(PatchInfo {_piLog=log}) = addJunk $ pi{_piLog = ignoreJunk log}
 -- This is a list so we can change the junk header.
 -- The first element will be used for new patches, the rest are also recognised
 -- in existing patches.
-ignored :: NonEmpty String
-ignored = "Ignore-this: " :| []
+ignored :: NonEmpty BS.ShortByteString
+ignored = fromString "Ignore-this: " :| []
 
-ignoreJunk :: [B.ByteString] -> [B.ByteString]
+ignoreJunk :: [BS.ShortByteString] -> [BS.ShortByteString]
 ignoreJunk = filter isnt_ignored
-    where isnt_ignored x = doesnt_start_with x (map BC.pack (NE.toList ignored)) -- TODO
-          doesnt_start_with x ys = not $ any (`B.isPrefixOf` x) ys
+    where isnt_ignored x = doesnt_start_with x (NE.toList ignored) -- TODO
+          doesnt_start_with x ys = not $ any (`BS.isPrefixOf` x) ys
 
 
 -- * Patch info formatting
@@ -247,10 +259,10 @@ justAuthor :: PatchInfo -> String
 justAuthor =  metadataToString . _piAuthor
 
 justLog :: PatchInfo -> String
-justLog = unlines . map BC.unpack . _piLog
+justLog = unlines . map (BC.unpack . BS.fromShort) . _piLog
 
-displayPatchInfo :: PatchInfo -> Doc
-displayPatchInfo pi =
+showPatchInfo :: PatchInfo -> Doc
+showPatchInfo pi =
     cyanText "patch " <> cyanText (show $ makePatchname pi)
  $$ text "Author: " <> text (piAuthor pi)
  $$ text "Date:   " <> text (friendlyD $ _piDate pi)
@@ -267,7 +279,7 @@ piName :: PatchInfo -> String
 piName = metadataToString . _piName
 
 piRename :: PatchInfo -> String -> PatchInfo
-piRename x n = x { _piName = packStringToUTF8 n }
+piRename x n = x { _piName = BS.toShort $ packStringToUTF8 n }
 
 -- | Returns the author of a patch.
 piAuthor :: PatchInfo -> String
@@ -280,14 +292,14 @@ isTag pinfo = "TAG " `isPrefixOf` justName pinfo
 -- The raw data may contain timezone info. This is for compatibiltity
 -- with patches that were created before 2003-11, when darcs still
 -- created patches that contained localized date strings.
-readPatchDate :: B.ByteString -> CalendarTime
-readPatchDate = readUTCDate . BC.unpack
+readPatchDate :: BS.ShortByteString -> CalendarTime
+readPatchDate = readUTCDate . BC.unpack . BS.fromShort
 
 piDate :: PatchInfo -> CalendarTime
 piDate = readPatchDate . _piDate
 
 piDateString :: PatchInfo -> String
-piDateString = BC.unpack . _piDate
+piDateString = BC.unpack . BS.fromShort . _piDate
 
 -- | Get the log message of a patch.
 piLog :: PatchInfo -> [String]
@@ -299,19 +311,19 @@ piTag pinf =
     if l == t
       then Just $ metadataToString r
       else Nothing
-    where (l, r) = B.splitAt (B.length t) (_piName pinf)
-          t = BC.pack "TAG "
+    where (l, r) = BS.splitAt (BS.length t) (_piName pinf)
+          t = fromString "TAG "
 
 -- | Convert a metadata ByteString to a string. It first tries to convert
 --   using UTF-8, and if that fails, tries the locale encoding.
 --   We try UTF-8 first because UTF-8 is clearly recognizable, widely used,
 --   and people may have UTF-8 patches even when UTF-8 is not their locale.
-metadataToString :: B.ByteString -> String
+metadataToString :: BS.ShortByteString -> String
 metadataToString bs | '\xfffd' `notElem` bsUtf8 = bsUtf8
-                    | otherwise                 = decodeLocale bs
-  where bsUtf8 = unpackPSFromUTF8 bs
+                    | otherwise                 = decodeLocale (BS.fromShort bs)
+  where bsUtf8 = unpackPSFromUTF8 (BS.fromShort bs)
 
-friendlyD :: B.ByteString -> String
+friendlyD :: BS.ShortByteString -> String
 friendlyD d = unsafePerformIO $ do
     ct <- toCalendarTime $ toClockTime $ readPatchDate d
     return $ calendarTimeToString ct
@@ -329,19 +341,19 @@ toXml' includeComments pi =
   -- is important because most programs that take XML as input for further
   -- processing simply fail otherwise.
   XML.unode "patch"
-    ( [ XML.Attr (XML.unqual "author") (unpackPSFromUTF8 (_piAuthor pi))
+    ( [ XML.Attr (XML.unqual "author") (unpackPSFromUTF8 $ BS.fromShort $ _piAuthor pi)
       , XML.Attr (XML.unqual "date") (piDateString pi)
       , XML.Attr (XML.unqual "local_date") (friendlyD $ _piDate pi)
       , XML.Attr (XML.unqual "inverted") (show $ _piLegacyIsInverted pi)
       , XML.Attr (XML.unqual "hash") (show $ makePatchname pi)
       ]
-    , [ XML.unode "name" $ unpackPSFromUTF8 (_piName pi) ] ++ comments
+    , [ XML.unode "name" $ unpackPSFromUTF8 $ BS.fromShort $ _piName pi ] ++ comments
     )
   where
     -- note that this is supposed to list junk as well, which is why piLog is not
     -- appropriate here
     comments
-      | includeComments = map (XML.unode "comment") (map unpackPSFromUTF8 $ _piLog pi)
+      | includeComments = map (XML.unode "comment") (map (unpackPSFromUTF8 . BS.fromShort) $ _piLog pi)
       | otherwise = []
 
 -- escapeXML is duplicated in Patch.lhs and Annotate.lhs
@@ -364,17 +376,13 @@ makePatchname :: PatchInfo -> SHA1
 makePatchname pi = sha1PS sha1_me
         where b2ps True = BC.pack "t"
               b2ps False = BC.pack "f"
-              sha1_me = B.concat [_piName pi,
-                                  _piAuthor pi,
-                                  _piDate pi,
-                                  B.concat $ _piLog pi,
+              sha1_me = BC.concat [BS.fromShort $ _piName pi,
+                                  BS.fromShort $ _piAuthor pi,
+                                  BS.fromShort $ _piDate pi,
+                                  BC.concat $ map BS.fromShort $ _piLog pi,
                                   b2ps $ _piLegacyIsInverted pi]
 
 
-showPatchInfo :: ShowPatchFor -> PatchInfo -> Doc
-showPatchInfo ForDisplay = displayPatchInfo
-showPatchInfo ForStorage = storePatchInfo
-
 -- |Patch is stored between square brackets.
 --
 -- > [ <patch name>
@@ -388,15 +396,19 @@ showPatchInfo ForStorage = storePatchInfo
 -- note that below I assume the name has no newline in it.
 -- See 'readPatchInfo' for the inverse operation.
 -- There are more assumptions, see validation functions above.
-storePatchInfo :: PatchInfo -> Doc
-storePatchInfo pi =
-    blueText "[" <> packedString (_piName pi)
- $$ packedString (_piAuthor pi) <> text inverted <> packedString (_piDate pi)
-                                 <> myunlines (_piLog pi) <> blueText "] "
-    where inverted = if _piLegacyIsInverted pi then "*-" else "**"
-          myunlines [] = empty
-          myunlines xs =
-              foldr (\s -> ((text "\n " <> packedString s) <>)) (text "\n") xs
+formatPatchInfo :: PatchInfo -> F.Format
+formatPatchInfo pi =
+  F.ascii "["
+    <> F.shortByteString (_piName pi) F.$$ F.shortByteString (_piAuthor pi)
+    <> F.ascii inverted
+    <> F.shortByteString (_piDate pi)
+    <> myunlines (map F.shortByteString (_piLog pi))
+    <> F.ascii "] "
+  where
+    inverted = if _piLegacyIsInverted pi then "*-" else "**"
+    myunlines [] = mempty
+    myunlines xs =
+      foldr (\s -> ((F.ascii "\n " <> s) <>)) (F.newline) xs
 
 -- |Parser for 'PatchInfo' as stored in patch bundles and inventory files,
 -- for example:
@@ -419,9 +431,9 @@ readPatchInfo = do
   ct <- takeTill (\c->c==']'||c=='\n')
   option () (void (char '\n')) -- consume newline char, if present
   log <- linesStartingWithEndingWith ' ' ']'
-  return PatchInfo { _piDate = ct
-                   , _piName = name
-                   , _piAuthor = author
-                   , _piLog = log
+  return PatchInfo { _piDate = BS.toShort ct
+                   , _piName = BS.toShort name
+                   , _piAuthor = BS.toShort author
+                   , _piLog = map BS.toShort log
                    , _piLegacyIsInverted = BC.index s2 1 /= '*'
                    }
diff --git a/src/Darcs/Patch/Invertible.hs b/src/Darcs/Patch/Invertible.hs
index 637077b2..89220eac 100644
--- a/src/Darcs/Patch/Invertible.hs
+++ b/src/Darcs/Patch/Invertible.hs
@@ -20,12 +20,10 @@ import Darcs.Patch.RepoPatch
     , Eq2(..)
     , PrimPatchBase(..)
     , PatchInspect(..)
-    , PatchListFormat(..)
     , ShowContextPatch(..)
     , ShowPatch(..)
     , ShowPatchBasic(..)
     )
-import Darcs.Patch.Show ( ShowPatchFor(..) )
 import Darcs.Patch.Witnesses.Ordered ((:>)(..))
 
 -- | Wrapper type to allow formal inversion of patches which aren't really
@@ -99,8 +97,7 @@ instance PrimPatchBase p => PrimPatchBase (Invertible p) where
   type PrimOf (Invertible p) = PrimOf p
 
 instance ShowPatchBasic p => ShowPatchBasic (Invertible p) where
-  showPatch ForStorage = error "Invertible patches must not be stored"
-  showPatch ForDisplay = withInvertible (showPatch ForDisplay)
+  showPatch = withInvertible showPatch
 
 instance ShowPatch p => ShowPatch (Invertible p) where
   -- note these are only used for display
@@ -109,7 +106,4 @@ instance ShowPatch p => ShowPatch (Invertible p) where
   content = withInvertible content
 
 instance ShowContextPatch p => ShowContextPatch (Invertible p) where
-  showPatchWithContextAndApply ForStorage = error "Invertible patches must not be stored"
-  showPatchWithContextAndApply ForDisplay = withInvertible (showPatchWithContextAndApply ForDisplay)
-
-instance PatchListFormat p => PatchListFormat (Invertible p)
+  showPatchWithContextAndApply = withInvertible showPatchWithContextAndApply
diff --git a/src/Darcs/Patch/Match.hs b/src/Darcs/Patch/Match.hs
index 6519044e..776dd1f9 100644
--- a/src/Darcs/Patch/Match.hs
+++ b/src/Darcs/Patch/Match.hs
@@ -53,12 +53,13 @@ module Darcs.Patch.Match
     , firstMatch
     , secondMatch
     , haveNonrangeMatch
-    , PatchSetMatch(..)
+    , PatchSetMatch
     , patchSetMatch
     , checkMatchSyntax
     , hasIndexRange
     , getMatchingTag
     , matchAPatchset
+    , matchOnePatchset
     , MatchFlag(..)
     , matchingHead
     , Matchable
@@ -99,8 +100,9 @@ import Data.List ( isPrefixOf, intercalate )
 import Data.Char ( toLower )
 import Data.Typeable ( Typeable )
 
-import Darcs.Util.Path ( AbsolutePath )
+import Darcs.Util.Path ( AbsolutePath, toFilePath )
 import Darcs.Patch ( hunkMatches, listTouchedFiles )
+import Darcs.Patch.Bundle ( readContextFile )
 import Darcs.Patch.Info ( justName, justAuthor, justLog, makePatchname,
                           piDate, piTag )
 
@@ -194,67 +196,70 @@ parseMatch pattern =
                 "'.\n"++ unlines (map ("    "++) $ lines $ show err) -- indent
     Right m -> Right (makeMatcher pattern m)
 
-matchPattern :: String -> Matcher
-matchPattern pattern =
+patternmatch :: String -> Matcher
+patternmatch pattern =
     case parseMatch pattern of
     Left err -> error err
     Right m -> m
 
 matchParser :: CharParser st MatchFun
-matchParser = submatcher <?> helpfulErrorMsg
+matchParser = (option matchAnyPatch expr <* eof) <?> helpfulErrorMsg
   where
-    submatcher = do
-        m <- option matchAnyPatch submatch
-        eof
-        return m
-
     -- When using <?>, Parsec prepends "expecting " to the given error message,
     -- so the phrasing below makes sense.
-    helpfulErrorMsg = "valid expressions over: "
-                      ++ intercalate ", " (map (\(name, _, _, _, _) -> name) ps)
-                      ++ "\nfor more help, see `darcs help patterns`."
-
-    ps = primitiveMatchers
+    helpfulErrorMsg =
+      "valid expressions over: "
+      ++ intercalate ", " (map (\(name, _, _, _, _) -> name) primitiveMatchers)
+      ++ "\nfor more help, see `darcs help patterns`."
 
-    -- matchAnyPatch is returned if submatch fails without consuming any
-    -- input, i.e. if we pass --match '', we want to match anything.
+    -- matchAnyPatch is returned if expr fails without consuming any
+    -- input, i.e. if we pass --match '', we want to match anything
     matchAnyPatch = MatchFun (const True)
 
-submatch :: CharParser st MatchFun
-submatch = buildExpressionParser table match
-
-table :: OperatorTable Char st MatchFun
-table   = [ [prefix "not" negate_match,
-             prefix "!" negate_match ]
-          , [binary "||" or_match,
-             binary "or" or_match,
-             binary "&&" and_match,
-            binary "and" and_match ]
-          ]
-    where binary name fun = Infix (tryNameAndUseFun name fun) AssocLeft
-          prefix name fun = Prefix $ tryNameAndUseFun name fun
-          tryNameAndUseFun name fun = do _ <- trystring name
-                                         spaces
-                                         return fun
-          negate_match (MatchFun m) = MatchFun $ \p -> not (m p)
-          or_match (MatchFun m1) (MatchFun m2) = MatchFun $ \p -> m1 p || m2 p
-          and_match (MatchFun m1) (MatchFun m2) = MatchFun $ \p -> m1 p && m2 p
-
-trystring :: String -> CharParser st String
-trystring s = try $ string s
-
-match :: CharParser st MatchFun
-match = between spaces spaces (parens submatch <|> choice matchers_)
-  where
-    matchers_ = map createMatchHelper primitiveMatchers
-
-createMatchHelper :: (String, String, String, [String], String -> MatchFun)
-                  -> CharParser st MatchFun
-createMatchHelper (key,_,_,_,matcher) =
-  do _ <- trystring key
-     spaces
-     q <- quoted
-     return $ matcher q
+    -- parse a non-empty full match expression
+    expr :: CharParser st MatchFun
+    expr = buildExpressionParser table term
+
+    table :: OperatorTable Char st MatchFun
+    table =
+      [ [ prefix "not" negate_match, prefix "!" negate_match ]
+      , [ binary "||" or_match
+        , binary "or" or_match
+        , binary "&&" and_match
+        , binary "and" and_match
+        ]
+      ]
+      where
+        binary name result = Infix (operator name result) AssocLeft
+        prefix name result = Prefix $ operator name result
+        operator name result = try (string name) >> spaces >> return result
+        negate_match (MatchFun m) = MatchFun $ \p -> not (m p)
+        or_match (MatchFun m1) (MatchFun m2) = MatchFun $ \p -> m1 p || m2 p
+        and_match (MatchFun m1) (MatchFun m2) = MatchFun $ \p -> m1 p && m2 p
+
+    -- parse a term, i.e. anything we can combine with operators:
+    -- an expression in parentheses or a primitive match expression
+    term :: CharParser st MatchFun
+    term = between spaces spaces (parens expr <|> choice prims)
+      where
+        -- the primitive match expression parsers
+        prims = map prim primitiveMatchers
+        -- a primitive match expression is a keyword followed by an argument;
+        -- the result is the passed matcher applied to the argument
+        prim (key, _, _, _, matcher) =
+          fmap matcher $ try (string key) >> spaces >> argument
+        -- an argument in a primitive match expression
+        argument :: CharParser st String
+        argument = quoted <|> unquoted <?> "string"
+        -- quoted string
+        quoted =
+          between (char '"') (char '"') (many $ try escaped <|> noneOf "\"")
+        -- bare (unquoted) string
+        unquoted = between spaces spaces (many $ noneOf " ()")
+        -- backslash escaped double quote or backslash
+        escaped = char '\\' >> oneOf "\\\""
+        -- any expression in parentheses
+        parens = between (string "(") (string ")")
 
 -- | The string that is emitted when the user runs @darcs help patterns@.
 helpOnMatchers :: [String]
@@ -302,6 +307,9 @@ primitiveMatchers =
  , ("name", "REGEX", "match REGEX against patch name"
           , ["issue17", "\"^[Rr]esolve issue17\\>\""]
           , namematch )
+ , ("tag", "STRING", "check literal STRING is equal to tag name"
+           , ["2.16.5.1", "\"done fixing issue1999\""]
+           , exacttagmatch )
  , ("author", "REGEX", "match REGEX against patch author"
             , ["\"David Roundy\"", "droundy", "droundy@darcs.net"]
             , authormatch )
@@ -321,21 +329,8 @@ primitiveMatchers =
           , ["src/foo.c", "src/", "\"src/*.(c|h)\""]
           , touchmatch ) ]
 
-parens :: CharParser st MatchFun
-       -> CharParser st MatchFun
-parens = between (string "(") (string ")")
-
-quoted :: CharParser st String
-quoted = between (char '"') (char '"')
-                 (many $ do { _ <- char '\\' -- allow escapes
-                            ; try (oneOf "\\\"") <|> return '\\'
-                            }
-                         <|>  noneOf "\"")
-         <|> between spaces spaces (many $ noneOf " ()")
-         <?> "string"
-
 datematch, hashmatch, authormatch, exactmatch, namematch, logmatch,
-  hunkmatch, touchmatch :: String -> MatchFun
+  hunkmatch, touchmatch, exacttagmatch :: String -> MatchFun
 
 namematch r =
   MatchFun $ \(Sealed2 hp) ->
@@ -343,6 +338,8 @@ namematch r =
 
 exactmatch r = MatchFun $ \(Sealed2 hp) -> r == justName (ident hp)
 
+exacttagmatch r = MatchFun $ \(Sealed2 hp) -> Just r == piTag (ident hp)
+
 authormatch a =
   MatchFun $ \(Sealed2 hp) ->
     isJust $ matchRegex (mkRegex a) $ justAuthor (ident hp)
@@ -388,7 +385,7 @@ data PatchSetMatch
 patchSetMatch :: [MatchFlag] -> Maybe PatchSetMatch
 patchSetMatch [] = Nothing
 patchSetMatch (OneTag t:_) = strictJust $ TagMatch $ tagmatch t
-patchSetMatch (OnePattern m:_) = strictJust $ PatchMatch $ matchPattern m
+patchSetMatch (OnePattern m:_) = strictJust $ PatchMatch $ patternmatch m
 patchSetMatch (OnePatch p:_) = strictJust $ PatchMatch $ patchmatch p
 patchSetMatch (OneHash h:_) = strictJust $ PatchMatch $ hashmatch' h
 patchSetMatch (OneIndex n:_) = strictJust $ IndexMatch n
@@ -455,11 +452,11 @@ strictJust x = Just $! x
 -- @--tag@ options are passed (or their plural variants).
 nonrangeMatcher :: [MatchFlag] -> Maybe Matcher
 nonrangeMatcher [] = Nothing
-nonrangeMatcher (OnePattern m:_) = strictJust $ matchPattern m
+nonrangeMatcher (OnePattern m:_) = strictJust $ patternmatch m
 nonrangeMatcher (OneTag t:_) = strictJust $ tagmatch t
 nonrangeMatcher (OnePatch p:_) = strictJust $ patchmatch p
 nonrangeMatcher (OneHash h:_) = strictJust $ hashmatch' h
-nonrangeMatcher (SeveralPattern m:_) = strictJust $ matchPattern m
+nonrangeMatcher (SeveralPattern m:_) = strictJust $ patternmatch m
 nonrangeMatcher (SeveralTag t:_) = strictJust $ tagmatch t
 nonrangeMatcher (SeveralPatch p:_) = strictJust $ patchmatch p
 nonrangeMatcher (_:fs) = nonrangeMatcher fs
@@ -470,8 +467,8 @@ nonrangeMatcher (_:fs) = nonrangeMatcher fs
 -- returns @Nothing@.
 firstMatcher :: [MatchFlag] -> Maybe Matcher
 firstMatcher [] = Nothing
-firstMatcher (OnePattern m:_) = strictJust $ matchPattern m
-firstMatcher (AfterPattern m:_) = strictJust $ matchPattern m
+firstMatcher (OnePattern m:_) = strictJust $ patternmatch m
+firstMatcher (AfterPattern m:_) = strictJust $ patternmatch m
 firstMatcher (AfterTag t:_) = strictJust $ tagmatch t
 firstMatcher (OnePatch p:_) = strictJust $ patchmatch p
 firstMatcher (AfterPatch p:_) = strictJust $ patchmatch p
@@ -486,8 +483,8 @@ firstMatcherIsTag (_:fs) = firstMatcherIsTag fs
 
 secondMatcher :: [MatchFlag] -> Maybe Matcher
 secondMatcher [] = Nothing
-secondMatcher (OnePattern m:_) = strictJust $ matchPattern m
-secondMatcher (UpToPattern m:_) = strictJust $ matchPattern m
+secondMatcher (OnePattern m:_) = strictJust $ patternmatch m
+secondMatcher (UpToPattern m:_) = strictJust $ patternmatch m
 secondMatcher (OnePatch p:_) = strictJust $ patchmatch p
 secondMatcher (UpToPatch p:_) = strictJust $ patchmatch p
 secondMatcher (OneHash h:_) = strictJust $ hashmatch' h
@@ -645,6 +642,17 @@ getMatchingTag m ps =
     PatchSet NilRL _ -> throw $ userError $ "Couldn't find a tag matching " ++ show m
     PatchSet ps' _ -> seal $ PatchSet ps' NilRL
 
+-- | Return the patches in a 'PatchSet' up to the given 'PatchSetMatch'.
+matchOnePatchset
+  :: MatchableRP p
+  => PatchSet p Origin wR
+  -> PatchSetMatch
+  -> IO (SealedPatchSet p Origin)
+matchOnePatchset ps (IndexMatch   n   ) = return $ patchSetDrop (n - 1) ps
+matchOnePatchset ps (PatchMatch   m   ) = return $ matchAPatchset m ps
+matchOnePatchset ps (TagMatch     m   ) = return $ getMatchingTag m ps
+matchOnePatchset ps (ContextMatch path) = readContextFile ps (toFilePath path)
+
 -- | Rollback (i.e. apply the inverse) of what remains of a 'PatchSet' after we
 -- extract a 'PatchSetMatch'. This is the counterpart of 'getOnePatchset' and
 -- is used to create a matching state. In particular, if the match is --index=n
diff --git a/src/Darcs/Patch/Named.hs b/src/Darcs/Patch/Named.hs
index ecab4192..e312bc38 100644
--- a/src/Darcs/Patch/Named.hs
+++ b/src/Darcs/Patch/Named.hs
@@ -53,9 +53,16 @@ import Darcs.Patch.Conflict ( Conflict(..), findConflicting, isConflicted )
 import Darcs.Patch.Debug ( PatchDebug(..) )
 import Darcs.Patch.Effect ( Effect(effect) )
 import Darcs.Patch.FileHunk ( IsHunk(..) )
-import Darcs.Patch.Format ( PatchListFormat )
-import Darcs.Patch.Info ( PatchInfo, readPatchInfo, showPatchInfo, patchinfo,
-                          piName, displayPatchInfo, makePatchname )
+import Darcs.Patch.Format ( FormatPatch(..) )
+import Darcs.Patch.Info
+    ( PatchInfo
+    , makePatchname
+    , patchinfo
+    , piName
+    , readPatchInfo
+    , showPatchInfo
+    , formatPatchInfo
+    )
 import Darcs.Patch.Merge ( CleanMerge(..), Merge(..) )
 import Darcs.Patch.Object ( ObjectId )
 import Darcs.Patch.Apply ( Apply(..), ObjectIdOfPatch )
@@ -63,7 +70,7 @@ import Darcs.Patch.Commute ( Commute(..) )
 import Darcs.Patch.Ident ( Ident(..), PatchId )
 import Darcs.Patch.Inspect ( PatchInspect(..) )
 import Darcs.Patch.Permutations ( genCommuteWhatWeCanRL )
-import Darcs.Patch.Read ( ReadPatch(..) )
+import Darcs.Patch.Read ( ReadPatch(..), ReadPatches(..) )
 import Darcs.Patch.FromPrim ( PrimPatchBase(..), FromPrim(..) )
 import Darcs.Util.Parser ( Parser, option, lexChar,
                                 choice, skipWhile, anyChar )
@@ -72,8 +79,7 @@ import Darcs.Patch.Show
     ( ShowContextPatch(..)
     , ShowPatch(..)
     , ShowPatchBasic(..)
-    , ShowPatchFor(..)
-    , displayPatch
+    , showPatch
     )
 import Darcs.Patch.Summary
     ( Summary(..)
@@ -92,6 +98,7 @@ import Darcs.Patch.Witnesses.Ordered
 import Darcs.Patch.Witnesses.Sealed ( Sealed, mapSeal )
 import Darcs.Patch.Witnesses.Show ( Show1, Show2 )
 
+import qualified Darcs.Util.Format as F
 import Darcs.Util.IsoDate ( showIsoDateTime, theBeginning )
 import Darcs.Util.Printer
     ( Doc, ($$), (<+>), text, vcat, cyanText, blueText, redText )
@@ -119,18 +126,16 @@ type instance PatchId (Named p) = PatchInfo
 instance Ident (Named p) where
     ident = patch2patchinfo
 
-instance IsHunk (Named p) where
-    isHunk _ = Nothing
-
-instance PatchListFormat (Named p)
+instance ReadPatches p => ReadPatch (Named p) where
+    readPatch' = readNamed
 
-instance (ReadPatch p, PatchListFormat p) => ReadPatch (Named p) where
- readPatch' = readNamed
+-- this instance is only needed for reading patch bundles
+instance ReadPatches p => ReadPatches (Named p)
 
-readNamed :: (ReadPatch p, PatchListFormat p) => Parser (Sealed (Named p wX))
+readNamed :: ReadPatches p => Parser (Sealed (Named p wX))
 readNamed = do n <- readPatchInfo
                d <- readDepends
-               p <- readPatch'
+               p <- readPatchFL'
                return $ (NamedP n d) `mapSeal` p
 
 readDepends :: Parser [PatchInfo]
@@ -270,7 +275,6 @@ instance ( Commute p
          , Conflict p
          , Summary p
          , PrimPatchBase p
-         , PatchListFormat p
          , ShowPatch p
          ) =>
          Conflict (Named p) where
@@ -415,37 +419,35 @@ instance Summary p => Summary (Named p) where
 instance Check p => Check (Named p) where
     isInconsistent (NamedP _ _ p) = isInconsistent p
 
--- ForStorage: note the difference between use of <> when there are
--- no explicit dependencies vs. <+> when there are
-showNamedPrefix :: ShowPatchFor -> PatchInfo -> [PatchInfo] -> Doc -> Doc
-showNamedPrefix f@ForStorage n [] p =
-    showPatchInfo f n <> p
-showNamedPrefix f@ForStorage n d p =
-    showPatchInfo f n
-    $$ blueText "<"
-    $$ vcat (map (showPatchInfo f) d)
-    $$ blueText ">"
-    <+> p
-showNamedPrefix f@ForDisplay n [] p =
-    showPatchInfo f n
-    $$ p
-showNamedPrefix f@ForDisplay n d p =
-    showPatchInfo f n
-    $$ showDependencies ShowNormalDeps ShowDepsVerbose d
-    $$ p
-
-instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (Named p) where
-    showPatch f (NamedP n d p) = showNamedPrefix f n d $ showPatch f p
+showNamedPrefix :: PatchInfo -> [PatchInfo] -> Doc -> Doc
+showNamedPrefix n d p =
+  showPatchInfo n $$ showDependencies ShowNormalDeps ShowDepsVerbose d $$ p
+
+instance FormatPatch p => FormatPatch (Named p) where
+    -- note the difference between use of <> when there are
+    -- no explicit dependencies vs. <+> when there are
+    formatPatch (NamedP n d ps) = storeNamedPrefix d $ formatPatchFL ps
+      where
+        storeNamedPrefix [] p = formatPatchInfo n <> p
+        storeNamedPrefix ds p =
+          F.vcat
+            [ formatPatchInfo n
+            , F.ascii "<"
+            , F.vcat (map formatPatchInfo ds)
+            , F.ascii ">" F.<+> p
+            ]
+
+instance ShowPatchBasic p => ShowPatchBasic (Named p) where
+    showPatch (NamedP n d p) = showNamedPrefix n d $ showPatch p
 
 instance ( Apply p
          , IsHunk p
-         , PatchListFormat p
          , ObjectId (ObjectIdOfPatch p)
          , ShowContextPatch p
          ) =>
          ShowContextPatch (Named p) where
-    showPatchWithContextAndApply f (NamedP n d p) =
-        showNamedPrefix f n d <$> showPatchWithContextAndApply f p
+    showPatchWithContextAndApply (NamedP n d p) =
+        showNamedPrefix n d <$> showPatchWithContextAndApply p
 
 data ShowDepsFormat = ShowDepsVerbose | ShowDepsSummary deriving (Eq)
 
@@ -468,9 +470,8 @@ showDependencies which format deps = vcat (map showDependency deps)
     mark ShowNormalDeps ShowDepsSummary = text "D"
     mark ShowDroppedDeps ShowDepsSummary = text "D!"
 
-instance (Summary p, PatchListFormat p,
-          PrimPatchBase p, ShowPatch p) => ShowPatch (Named p) where
-    description (NamedP n _ _) = displayPatchInfo n
+instance (Summary p, PrimPatchBase p, ShowPatch p) => ShowPatch (Named p) where
+    description (NamedP n _ _) = showPatchInfo n
     summary (NamedP _ ds ps) =
         showDependencies ShowNormalDeps ShowDepsSummary ds $$ plainSummaryFL ps
     summaryFL nps =
@@ -479,7 +480,7 @@ instance (Summary p, PatchListFormat p,
         ds = nubSort $ concat $ mapFL getdeps nps
         ps = concatFL $ mapFL_FL patchcontents nps
     content (NamedP _ ds ps) =
-        showDependencies ShowNormalDeps ShowDepsVerbose ds $$ displayPatch ps
+        showDependencies ShowNormalDeps ShowDepsVerbose ds $$ showPatch ps
 
 instance Show2 p => Show1 (Named p wX)
 
diff --git a/src/Darcs/Patch/Object.hs b/src/Darcs/Patch/Object.hs
index ba4d8071..da45884d 100644
--- a/src/Darcs/Patch/Object.hs
+++ b/src/Darcs/Patch/Object.hs
@@ -2,12 +2,8 @@ module Darcs.Patch.Object where
 
 import Darcs.Prelude
 
-import qualified Data.ByteString.Char8 as BC ( unpack )
-
-import Darcs.Patch.Format ( FileNameFormat(..) )
-import Darcs.Util.ByteString ( packStringToUTF8, encodeLocale )
-import Darcs.Util.Path ( AnchoredPath, encodeWhite, anchorPath )
-import Darcs.Util.Printer ( Doc, text, packedString )
+import Darcs.Util.Path ( AnchoredPath, anchorPath )
+import Darcs.Util.Printer ( Doc, text )
 import Darcs.Util.Tree ( Tree )
 
 -- | Given a state type (parameterized over a monad m :: Type -> Type), this gives us
@@ -16,34 +12,11 @@ import Darcs.Util.Tree ( Tree )
 type family ObjectIdOf (state :: (Type -> Type) -> Type)
 
 -- | We require from such a key (an 'ObjectId') that it has a canonical way
--- to format itself to a 'Doc'. For historical reasons, this takes a parameter
--- of type 'FileNameFormat'.
+-- to format itself to a 'Doc'.
 class Eq oid => ObjectId oid where
-  formatObjectId :: FileNameFormat -> oid -> Doc
+  showObjectId :: oid -> Doc
 
 type instance ObjectIdOf Tree = AnchoredPath
 
--- formatFileName is defined here only to avoid an import cycle
-
--- | Format a 'AnchoredPath' to a 'Doc' according to the given 'FileNameFormat'.
---
--- NOTE: This is not only used for display but also to format patch files. This is
---       why we have to do the white space encoding here.
---       See 'Darcs.Repository.Hashed.writePatchIfNecessary'.
---
--- Besides white space encoding, for 'FileNameFormatV2' we just pack it into a 'Doc'. For
--- 'FileNameFormatV1' we must emulate the non-standard darcs-1 encoding of file paths: it
--- is an UTF8 encoding of the raw byte stream, interpreted as code points.
---
--- See also 'Darcs.Patch.Show.readFileName'.
-formatFileName :: FileNameFormat -> AnchoredPath -> Doc
-formatFileName FileNameFormatV1 =
-  packedString . packStringToUTF8 . BC.unpack . encodeLocale . encodeWhite . ap2fp
-formatFileName FileNameFormatV2 = text . encodeWhite . ap2fp
-formatFileName FileNameFormatDisplay = text . ap2fp
-
 instance ObjectId AnchoredPath where
-  formatObjectId = formatFileName
-
-ap2fp :: AnchoredPath -> FilePath
-ap2fp ap = "./" ++ anchorPath "" ap
+  showObjectId = text . anchorPath "."
diff --git a/src/Darcs/Patch/PatchInfoAnd.hs b/src/Darcs/Patch/PatchInfoAnd.hs
index 16760bf2..0a3ee202 100644
--- a/src/Darcs/Patch/PatchInfoAnd.hs
+++ b/src/Darcs/Patch/PatchInfoAnd.hs
@@ -16,12 +16,10 @@
 -- Boston, MA 02110-1301, USA.
 
 module Darcs.Patch.PatchInfoAnd
-    ( Hopefully
-    , PatchInfoAnd
+    ( PatchInfoAnd
     , PatchInfoAndG
     , piap
     , n2pia
-    , patchInfoAndPatch
     , fmapPIAP
     , fmapFLPIAP
     , hopefully
@@ -29,7 +27,6 @@ module Darcs.Patch.PatchInfoAnd
     , hopefullyM
     , createHashed
     , extractHash
-    , actually
     , unavailable
     , patchDesc
     ) where
@@ -37,110 +34,89 @@ module Darcs.Patch.PatchInfoAnd
 import Darcs.Prelude
 
 import Control.Exception ( Exception, throw )
-import System.IO.Unsafe ( unsafeInterleaveIO )
 import Data.Typeable ( Typeable )
+import System.IO.Unsafe ( unsafeInterleaveIO )
 
 import Darcs.Patch.Apply ( Apply(..) )
 import Darcs.Patch.Commute ( Commute(..) )
 import Darcs.Patch.Conflict ( Conflict(..) )
 import Darcs.Patch.Debug ( PatchDebug(..) )
 import Darcs.Patch.Effect ( Effect(..) )
-import Darcs.Patch.FileHunk ( IsHunk(..) )
-import Darcs.Patch.Format ( PatchListFormat )
 import Darcs.Patch.FromPrim ( PrimPatchBase(..) )
 import Darcs.Patch.Ident ( Ident(..), PatchId )
-import Darcs.Patch.Info ( PatchInfo, displayPatchInfo, justName, showPatchInfo )
+import Darcs.Patch.Info ( PatchInfo, justName, showPatchInfo )
 import Darcs.Patch.Inspect ( PatchInspect(..) )
 import Darcs.Patch.Merge ( CleanMerge(..), Merge(..) )
 import Darcs.Patch.Named ( Named, fmapFL_Named )
-import Darcs.Patch.Read ( ReadPatch(..) )
 import Darcs.Patch.Repair ( Repair(..), RepairToFL )
-import Darcs.Patch.Show ( ShowPatch(..) )
-import Darcs.Patch.Show ( ShowContextPatch(..), ShowPatchBasic(..) )
+import Darcs.Patch.Show ( ShowContextPatch(..), ShowPatch(..), ShowPatchBasic(..) )
 import Darcs.Patch.Summary ( Summary )
-import Darcs.Patch.Witnesses.Eq ( Eq2(..) )
 import Darcs.Patch.Witnesses.Ordered
-    ( (:/\:)(..)
-    , (:>)(..)
-    , (:\/:)(..)
-    , FL
+    ( FL
     , mapFL
     , mapRL_RL
+    , (:/\:)(..)
+    , (:>)(..)
+    , (:\/:)(..)
     )
-import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed), mapSeal, seal )
+import Darcs.Patch.Witnesses.Sealed ( Sealed, mapSeal, seal )
 import Darcs.Patch.Witnesses.Show ( Show1, Show2 )
 import Darcs.Util.Exception ( prettyException )
 import Darcs.Util.Printer ( Doc, renderString, text, vcat, ($$) )
 import Darcs.Util.SignalHandler ( catchNonSignal )
 import Darcs.Util.ValidHash ( PatchHash )
 
--- | @'Hopefully' p C@ @(x y)@ is @'Either' String (p C@ @(x y))@ in a
--- form adapted to darcs patches. The @C@ @(x y)@ represents the type
--- witness for the patch that should be there. The @Hopefully@ type
--- just tells whether we expect the patch to be hashed or not, and
--- 'SimpleHopefully' does the real work of emulating
--- 'Either'. @Hopefully sh@ represents an expected unhashed patch, and
--- @Hashed hash sh@ represents an expected hashed patch with its hash.
-data Hopefully a wX wY
-    = Hopefully (SimpleHopefully a wX wY)
-    | Hashed PatchHash (SimpleHopefully a wX wY)
-    deriving Show
-
--- | @SimpleHopefully@ is a variant of @Either String@ adapted for
--- type witnesses. @Actually@ is the equivalent of @Right@, while
--- @Unavailable@ is @Left@.
-data SimpleHopefully a wX wY = Actually (a wX wY) | Unavailable String
-    deriving Show
-
+-- | Specialized variant of 'PatchInfoAndG', where the underlying patch is
+-- always a 'Named' patch. These are the patches we normally store and read
+-- in a repository.
 type PatchInfoAnd p = PatchInfoAndG (Named p)
 
--- | @'PatchInfoAnd' p wA wB@ represents a hope we have to get a
--- patch through its info. We're not sure we have the patch, but we
--- know its info.
+-- | The type of patches we can read from inventories. Inventories have the
+-- 'PatchInfo' and the (SHA256) hash of the patch content, but not the content
+-- itself. So a 'PatchInfoAnd' always has a 'PatchInfo', but may be missing the
+-- underlying patch. It may also be missing a content hash because operations
+-- that (potentially) modify the content (like commutation) invalidate the
+-- hash.
+--
+-- This generalized type is mostly needed to deal with legacy rebase versions.
 data PatchInfoAndG p wA wB =
-  PIAP !PatchInfo
+  PIAP PatchInfo
+       (Maybe PatchHash)
        (Hopefully p wA wB)
   deriving (Show)
 
-fmapH :: (a wX wY -> b wW wZ) -> Hopefully a wX wY -> Hopefully b wW wZ
-fmapH f (Hopefully sh) = Hopefully (ff sh)
-    where ff (Actually a) = Actually (f a)
-          ff (Unavailable e) = Unavailable e
-fmapH f (Hashed _ sh) = Hopefully (ff sh)
-    where ff (Actually a) = Actually (f a)
-          ff (Unavailable e) = Unavailable e
+-- | Like 'Either String' but with type witnesses.
+data Hopefully p wX wY = Unavailable String | Actually (p wX wY)
+  deriving Show
+
+fmapH :: (p wX wY -> b wX wY) -> Hopefully p wX wY -> Hopefully b wX wY
+fmapH _ (Unavailable e) = Unavailable e
+fmapH f (Actually p) = Actually (f p)
 
+-- | The 'PatchInfo' of a 'PatchInfoAndG'
 info :: PatchInfoAndG p wA wB -> PatchInfo
-info (PIAP i _) = i
+info (PIAP i _ _) = i
 
+-- | Just the name part of the info as a 'String'.
 patchDesc :: forall p wX wY . PatchInfoAnd p wX wY -> String
 patchDesc p = justName $ info p
 
--- | @'piap' i p@ creates a PatchInfoAnd containing p with info i.
+-- | Create a 'PatchInfoAndG' with the given info and patch and no hash.
 piap :: PatchInfo -> p wA wB -> PatchInfoAndG p wA wB
-piap i p = PIAP i (Hopefully $ Actually p)
+piap i p = PIAP i Nothing (Actually p)
 
--- | @n2pia@ creates a PatchInfoAnd representing a @Named@ patch.
+-- | Create a 'PatchInfoAndG' from a patch with an identity whose type
+-- coincides with 'PatchInfo'.
 n2pia :: (Ident p, PatchId p ~ PatchInfo) => p wX wY -> PatchInfoAndG p wX wY
 n2pia x = ident x `piap` x
 
-patchInfoAndPatch :: PatchInfo -> Hopefully p wA wB -> PatchInfoAndG p wA wB
-patchInfoAndPatch =  PIAP
+fmapFLPIAP
+  :: (FL p wX wY -> FL q wX wY) -> PatchInfoAnd p wX wY -> PatchInfoAnd q wX wY
+fmapFLPIAP f (PIAP i _ hp) = PIAP i Nothing (fmapH (fmapFL_Named f) hp)
 
-fmapFLPIAP :: (FL p wX wY -> FL q wX wY)
-           -> PatchInfoAnd p wX wY -> PatchInfoAnd q wX wY
-fmapFLPIAP f (PIAP i hp) = PIAP i (fmapH (fmapFL_Named f) hp)
-
-fmapPIAP :: (p wX wY -> q wX wY)
-           -> PatchInfoAndG p wX wY -> PatchInfoAndG q wX wY
-fmapPIAP f (PIAP i hp) = PIAP i (fmapH f hp)
-
--- | @'hopefully' hp@ tries to get a patch from a 'PatchInfoAnd'
--- value. If it fails, it outputs an error \"failed to read patch:
--- \<description of the patch>\". We get the description of the patch
--- from the info part of 'hp'
-hopefully :: PatchInfoAndG p wA wB -> p wA wB
-hopefully = conscientiously $ \e -> text "failed to read patch:" $$ e
+fmapPIAP
+  :: (p wX wY -> q wX wY) -> PatchInfoAndG p wX wY -> PatchInfoAndG q wX wY
+fmapPIAP f (PIAP i _ hp) = PIAP i Nothing (fmapH f hp)
 
 -- | Using a special exception type here means that is is treated as
 -- regular failure, and not as a bug in Darcs.
@@ -152,47 +128,47 @@ instance Exception PatchNotAvailable
 instance Show PatchNotAvailable where
   show (PatchNotAvailable e) = renderString e
 
--- | @'conscientiously' er hp@ tries to extract a patch from a 'PatchInfoAnd'.
--- If it fails, it applies the error handling function @er@ to a description
--- of the patch info component of @hp@.
--- Note: this function must be lazy in its second argument, which is why we
--- use a lazy pattern match.
-conscientiously :: (Doc -> Doc)
-                -> PatchInfoAndG p wA wB -> p wA wB
-conscientiously er ~(PIAP pinf hp) =
-    case hopefully2either hp of
-      Right p -> p
-      Left e -> throw $ PatchNotAvailable $ er (displayPatchInfo pinf $$ text e)
-
 -- | Return 'Just' the patch content or 'Nothing' if it is unavailable.
 hopefullyM :: PatchInfoAndG p wA wB -> Maybe (p wA wB)
-hopefullyM (PIAP _ hp) = case hopefully2either hp of
-                              Right p -> return p
-                              Left _ -> Nothing
-
--- Any recommendations for a nice adverb to name the below?
-hopefully2either :: Hopefully a wX wY -> Either String (a wX wY)
-hopefully2either (Hopefully (Actually p)) = Right p
-hopefully2either (Hashed _ (Actually p)) = Right p
-hopefully2either (Hopefully (Unavailable e)) = Left e
-hopefully2either (Hashed _ (Unavailable e)) = Left e
-
-actually :: a wX wY -> Hopefully a wX wY
-actually = Hopefully . Actually
-
-createHashed :: PatchHash -> (PatchHash -> IO (Sealed (a wX))) -> IO (Sealed (Hopefully a wX))
-createHashed h f = mapSeal (Hashed h) `fmap` unsafeInterleaveIO (f' `catchNonSignal` handler)
+hopefullyM (PIAP _ _ hp) =
+  case hp of
+    Actually p -> return p
+    Unavailable _ -> Nothing
+
+-- | Try to get a patch from a 'PatchInfoAndG'. If it fails, it throws a
+-- 'PatchNotAvailable' exception.
+hopefully :: PatchInfoAndG p wA wB -> p wA wB
+-- Note: the lazy pattern match is required by the way this function is used
+hopefully ~(PIAP pinf _ hp) =
+  case hp of
+    Actually p -> p
+    Unavailable e -> throw $ PatchNotAvailable $
+      text "failed to read patch:" $$ showPatchInfo pinf $$ text e
+
+-- | Construct an 'Unavailable' patch. Used e.g. when reading the context
+-- part of a patch bundle.
+unavailable :: PatchInfo -> String -> PatchInfoAndG p wX wY
+unavailable i e = PIAP i Nothing (Unavailable e)
+
+-- | Lift an 'IO' action that reads a patch (given its hash) to one
+-- that reads a 'PatchInfoAndG'. The read action is delayed using
+-- 'unsafeInterleaveIO' and all non-signal exceptions it may throw
+-- are handled by creating an 'Unavailable' patch.
+createHashed
+  :: PatchInfo
+  -> PatchHash
+  -> IO (Sealed (p wX))
+  -> IO (Sealed (PatchInfoAndG p wX))
+createHashed i h reader =
+  mapSeal (PIAP i (Just h)) <$>
+    unsafeInterleaveIO ((mapSeal Actually <$> reader) `catchNonSignal` handler)
   where
-  f' = do Sealed x <- f h
-          return (Sealed (Actually x))
-  handler e = return $ seal $ Unavailable $ prettyException e
+    handler e = return $ seal $ Unavailable $ prettyException e
 
+-- | Return either the hash (if available) or else the underlying patch.
 extractHash :: PatchInfoAndG p wA wB -> Either (p wA wB) PatchHash
-extractHash (PIAP _ (Hashed sh _)) = Right sh
-extractHash hp = Left $ conscientiously (\e -> text "unable to read patch:" $$ e) hp
-
-unavailable :: String -> Hopefully a wX wY
-unavailable = Hopefully . Unavailable
+extractHash (PIAP _ (Just h) _) = Right h
+extractHash p = Left (hopefully p)
 
 -- * Instances defined only for PatchInfoAnd
 
@@ -211,53 +187,34 @@ instance RepairToFL p => Repair (PatchInfoAnd p) where
 instance PrimPatchBase p => PrimPatchBase (PatchInfoAndG p) where
    type PrimOf (PatchInfoAndG p) = PrimOf p
 
-getHopefully :: Hopefully p wX wY -> SimpleHopefully p wX wY
-getHopefully (Hashed _ x) = x
-getHopefully (Hopefully x) = x
-
-instance Eq2 p => Eq2 (SimpleHopefully p) where
-    Actually p1 `unsafeCompare` Actually p2 = p1 `unsafeCompare` p2
-    _ `unsafeCompare` _ = error "cannot compare unavailable patches"
-
-instance Eq2 p => Eq2 (Hopefully p) where
-    Hashed h1 _ `unsafeCompare` Hashed h2 _ = h1 == h2
-    hp1 `unsafeCompare` hp2 =
-      getHopefully hp1 `unsafeCompare` getHopefully hp2
-
-instance Eq2 p => Eq2 (PatchInfoAndG p) where
-    PIAP i1 p1 `unsafeCompare` PIAP i2 p2 = i1 == i2 && p1 `unsafeCompare` p2
-
 type instance PatchId (PatchInfoAndG p) = PatchInfo
 
 instance Ident (PatchInfoAndG p) where
-    ident (PIAP i _) = i
-
-instance PatchListFormat (PatchInfoAndG p)
+    ident = info
 
 instance ShowPatchBasic p => ShowPatchBasic (PatchInfoAndG p) where
-    showPatch f (PIAP n p) =
-      case hopefully2either p of
-        Right x -> showPatch f x
-        Left _ -> showPatchInfo f n
+    showPatch (PIAP n _ p) =
+      case p of
+        Actually x -> showPatch x
+        Unavailable _ -> showPatchInfo n
 
 instance ShowContextPatch p => ShowContextPatch (PatchInfoAndG p) where
-  showPatchWithContextAndApply f (PIAP n p) =
-    case hopefully2either p of
-      Right x -> showPatchWithContextAndApply f x
-      Left _ -> return $ showPatchInfo f n
-
-instance (Summary p, PatchListFormat p,
-          ShowPatch p) => ShowPatch (PatchInfoAndG p) where
-    description (PIAP n _) = displayPatchInfo n
-    summary (PIAP _ p) =
-      case hopefully2either p of
-        Right x -> summary x
-        Left _ -> text $ "[patch summary is unavailable]"
+  showPatchWithContextAndApply (PIAP n _ p) =
+    case p of
+      Actually x -> showPatchWithContextAndApply x
+      Unavailable _ -> return $ showPatchInfo n
+
+instance (Summary p, ShowPatch p) => ShowPatch (PatchInfoAndG p) where
+    description (PIAP n _ _) = showPatchInfo n
+    summary (PIAP _ _ p) =
+      case p of
+        Actually x -> summary x
+        Unavailable _ -> text $ "[patch summary is unavailable]"
     summaryFL = vcat . mapFL summary
-    content (PIAP _ p) =
-      case hopefully2either p of
-        Right x -> content x
-        Left _ -> text $ "[patch content is unavailable]"
+    content (PIAP _ _ p) =
+      case p of
+        Actually x -> content x
+        Unavailable _ -> text $ "[patch content is unavailable]"
 
 instance (PatchId p ~ PatchInfo, Commute p) => Commute (PatchInfoAndG p) where
     commute (x :> y) = do y' :> x' <- commute (hopefully x :> hopefully y)
@@ -287,19 +244,12 @@ instance Apply p => Apply (PatchInfoAndG p) where
     apply = apply . hopefully
     unapply = unapply . hopefully
 
-instance ( ReadPatch p, Ident p, PatchId p ~ PatchInfo
-         ) => ReadPatch (PatchInfoAndG p) where
-    readPatch' = mapSeal n2pia <$> readPatch'
-
 instance Effect p => Effect (PatchInfoAndG p) where
     effect = effect . hopefully
 
-instance IsHunk (PatchInfoAndG p) where
-    isHunk _ = Nothing
-
 instance PatchDebug p => PatchDebug (PatchInfoAndG p)
 
-instance (Commute p, Conflict p, Summary p, PrimPatchBase p, PatchListFormat p, ShowPatch p) => Conflict (PatchInfoAnd p) where
+instance (Commute p, Conflict p, Summary p, PrimPatchBase p, ShowPatch p) => Conflict (PatchInfoAnd p) where
     numConflicts = numConflicts . hopefully
     -- Note: this relies on the laziness of 'hopefully' for efficiency
     -- and correctness in the face of lazy repositories
diff --git a/src/Darcs/Patch/Permutations.hs b/src/Darcs/Patch/Permutations.hs
index ba921be5..dd6e4df3 100644
--- a/src/Darcs/Patch/Permutations.hs
+++ b/src/Darcs/Patch/Permutations.hs
@@ -130,16 +130,14 @@ partitionRL :: forall p wX wY. Commute p
             => (forall wU wV . p wU wV -> Bool) -- ^predicate; if true we would like the patch in the "right" list
             -> RL p wX wY                       -- ^input 'RL'
             -> (RL p :> RL p) wX wY             -- ^"left" and "right" results
-partitionRL keepright = go . (:> NilFL)
+partitionRL cond input = go (input :> NilFL :> NilFL)
   where
-    go :: (RL p :> FL p) wA wB -> (RL p :> RL p) wA wB
-    go (NilRL :> qs) = (reverseFL qs :> NilRL)
-    go (ps :<: p :> qs)
-      | keepright p
-      , Just (qs' :> p') <- commuteFL (p :> qs) =
-          case go (ps :> qs') of
-            a :> b -> a :> b :<: p'
-      | otherwise = go (ps :> p :>: qs)
+    go :: (RL p :> FL p :> FL p) wA wB -> (RL p :> RL p) wA wB
+    go (NilRL :> no :> yes) = (reverseFL no :> reverseFL yes)
+    go (ps :<: p :> no :> yes)
+      | cond p
+      , Just (no' :> p') <- commuteFL (p :> no) = go (ps :> no' :> p' :>: yes)
+      | otherwise = go (ps :> p :>: no :> yes)
 
 commuteWhatWeCanFL :: Commute p => (p :> FL p) wX wY -> (FL p :> p :> FL p) wX wY
 commuteWhatWeCanFL = genCommuteWhatWeCanFL commute
diff --git a/src/Darcs/Patch/Prim.hs b/src/Darcs/Patch/Prim.hs
index 92944837..0a96b797 100644
--- a/src/Darcs/Patch/Prim.hs
+++ b/src/Darcs/Patch/Prim.hs
@@ -5,8 +5,6 @@ module Darcs.Patch.Prim
     , PrimDetails(..)
     , PrimMangleUnravelled(..)
     , PrimPatch
-    , PrimRead(..)
-    , PrimShow(..)
     , PrimSift(..)
     , Mangled
     , Unravelled
@@ -21,8 +19,6 @@ import Darcs.Patch.Prim.Class
     , PrimDetails(..)
     , PrimMangleUnravelled(..)
     , PrimPatch
-    , PrimRead(..)
-    , PrimShow(..)
     , PrimSift(..)
     , Mangled
     , Unravelled
diff --git a/src/Darcs/Patch/Prim/Canonize.hs b/src/Darcs/Patch/Prim/Canonize.hs
index 0a3eb54c..75758d99 100644
--- a/src/Darcs/Patch/Prim/Canonize.hs
+++ b/src/Darcs/Patch/Prim/Canonize.hs
@@ -3,32 +3,24 @@ module Darcs.Patch.Prim.Canonize ( canonizeFL ) where
 
 import Darcs.Prelude
 
-import qualified Data.ByteString as B (ByteString, empty)
+import qualified Data.ByteString as B ( empty )
 
 import Darcs.Patch.FileHunk ( FileHunk(..), IsHunk(..) )
-import Darcs.Patch.Prim.Class
-    ( PrimConstruct(primFromHunk)
-    , PrimCoalesce(sortCoalesceFL)
-    )
-import Darcs.Patch.Witnesses.Ordered ( FL(..), joinGapsFL, mapFL_FL, concatFL )
-import Darcs.Patch.Witnesses.Sealed ( unseal, Gap(..), unFreeLeft )
+import Darcs.Patch.Prim.Class ( PrimCoalesce(sortCoalesceFL) )
+import Darcs.Patch.Witnesses.Ordered ( FL(..), mapFL_FL, concatFL )
 import Darcs.Patch.Witnesses.Unsafe ( unsafeCoercePEnd )
 import Darcs.Util.Diff ( DiffAlgorithm, getChanges )
 
-canonizeHunk :: Gap w => DiffAlgorithm -> FileHunk oid wX wY -> w (FL (FileHunk oid))
-canonizeHunk _ (FileHunk f line old new)
-  | null old || null new || old == [B.empty] || new == [B.empty] =
-      freeGap (FileHunk f line old new :>: NilFL)
-canonizeHunk da (FileHunk f line old new) =
-  makeHoley f line $ getChanges da old new
+canonizeHunk :: DiffAlgorithm -> FileHunk xd oid wX wY -> FL (FileHunk xd oid) wX wY
+canonizeHunk da h@(FileHunk xd f line old new)
+  | null old || null new || old == [B.empty] || new == [B.empty] = h :>: NilFL
+  | otherwise =
+      buildFL (\(l, o, n) -> FileHunk xd f (l + line) o n) $ getChanges da old new
 
-makeHoley :: Gap w
-          => oid
-          -> Int
-          -> [(Int, [B.ByteString], [B.ByteString])]
-          -> w (FL (FileHunk oid))
-makeHoley f line =
-  joinGapsFL . map (\(l, o, n) -> freeGap (FileHunk f (l + line) o n))
+buildFL
+  :: (forall wA wB . a -> FileHunk xd oid wA wB) -> [a] -> FL (FileHunk xd oid) wX wY
+buildFL _ [] = unsafeCoercePEnd NilFL
+buildFL f (x:xs) = f x :>: buildFL f xs
 
 -- | It can sometimes be handy to have a canonical representation of a given
 -- patch.  We achieve this by defining a canonical form for each patch type,
@@ -36,10 +28,10 @@ makeHoley f line =
 -- canonical form.  This routine is used by the diff function to create an
 -- optimal patch (based on an LCS algorithm) from a simple hunk describing the
 -- old and new version of a file.
-canonize :: (IsHunk prim, PrimConstruct prim)
+canonize :: IsHunk prim
          => DiffAlgorithm -> prim wX wY -> FL prim wX wY
 canonize da p | Just fh <- isHunk p =
-  mapFL_FL primFromHunk $ unseal unsafeCoercePEnd $ unFreeLeft $ canonizeHunk da fh
+  mapFL_FL fromHunk $ canonizeHunk da fh
 canonize _ p = p :>: NilFL
 
 -- | Put a sequence of primitive patches into canonical form.
@@ -53,12 +45,7 @@ canonize _ p = p :>: NilFL
 -- sortCoalesceFL and then invokes the diff algorithm for each hunk. How can
 -- that be any different to applying the sequence and then taking the diff?
 -- Is this merely because diff does not sort by file path?
---
--- Besides, diff and apply /must/ be inverses in the sense that for any two
--- states {start, end}, we have
---
--- prop> diff start (apply (diff start end)) == end
-canonizeFL :: (IsHunk prim, PrimCoalesce prim, PrimConstruct prim)
+canonizeFL :: (IsHunk prim, PrimCoalesce prim)
            => DiffAlgorithm -> FL prim wX wY -> FL prim wX wY
 -- Note: it is important to first coalesce and then canonize, since
 -- coalescing can produce non-canonical hunks (while hunks resulting
diff --git a/src/Darcs/Patch/Prim/Class.hs b/src/Darcs/Patch/Prim/Class.hs
index e8f5752d..3fb3da81 100644
--- a/src/Darcs/Patch/Prim/Class.hs
+++ b/src/Darcs/Patch/Prim/Class.hs
@@ -3,13 +3,12 @@ module Darcs.Patch.Prim.Class
     , PrimCoalesce(..)
     , PrimDetails(..)
     , PrimSift(..)
-    , PrimShow(..)
-    , PrimRead(..)
     , PrimApply(..)
     , PrimPatch
     , PrimMangleUnravelled(..)
     , Mangled
     , Unravelled
+    , showPrimWithContextAndApply
     , primCleanMerge
     )
     where
@@ -18,24 +17,25 @@ import Darcs.Prelude
 
 import Darcs.Patch.Annotate.Class ( Annotate )
 import Darcs.Patch.ApplyMonad ( ApplyMonad )
-import Darcs.Patch.FileHunk ( FileHunk, IsHunk )
-import Darcs.Patch.Format ( FileNameFormat, PatchListFormat )
+import Darcs.Patch.FileHunk ( IsHunk(..) )
 import Darcs.Patch.Inspect ( PatchInspect )
 import Darcs.Patch.Apply ( Apply(..), ObjectIdOfPatch )
 import Darcs.Patch.Commute ( Commute(..) )
 import Darcs.Patch.CommuteFn ( PartialMergeFn )
+import Darcs.Patch.Format ( FormatPatch )
 import Darcs.Patch.Invert ( Invert(..) )
 import Darcs.Patch.Merge ( CleanMerge(..) )
-import Darcs.Patch.Read ( ReadPatch )
+import Darcs.Patch.Object ( ObjectId )
+import Darcs.Patch.Read ( ReadPatches )
 import Darcs.Patch.Repair ( RepairToFL )
-import Darcs.Patch.Show ( ShowPatch, ShowContextPatch )
+import Darcs.Patch.Show ( ShowContextPatch, ShowPatch, ShowPatchBasic(..) )
 import Darcs.Patch.SummaryData ( SummDetail )
+import Darcs.Patch.Viewing ( showContextHunk )
 import Darcs.Patch.Witnesses.Eq ( Eq2(..), EqCheck )
 import Darcs.Patch.Witnesses.Ordered ( (:/\:)(..), (:>)(..), (:\/:)(..), FL )
 import Darcs.Patch.Witnesses.Show ( Show2 )
 import Darcs.Patch.Witnesses.Sealed ( Sealed )
 
-import Darcs.Util.Parser ( Parser )
 import Darcs.Util.Path ( AnchoredPath )
 import Darcs.Util.Printer ( Doc )
 
@@ -59,10 +59,10 @@ type PrimPatch prim =
     , PrimApply prim
     , PrimSift prim
     , PrimMangleUnravelled prim
-    , ReadPatch prim
+    , ReadPatches prim
     , ShowPatch prim
     , ShowContextPatch prim
-    , PatchListFormat prim
+    , FormatPatch prim
     )
 
 class PrimConstruct prim where
@@ -75,7 +75,6 @@ class PrimConstruct prim where
    hunk :: AnchoredPath -> Int -> [B.ByteString] -> [B.ByteString] -> prim wX wY
    tokreplace :: AnchoredPath -> String -> String -> String -> prim wX wY
    binary :: AnchoredPath -> B.ByteString -> B.ByteString -> prim wX wY
-   primFromHunk :: FileHunk (ObjectIdOfPatch prim) wX wY -> prim wX wY
 
 class (Commute prim, Eq2 prim, Invert prim) => PrimCoalesce prim where
    -- | Try to shrink the input sequence by getting rid of self-cancellations
@@ -123,12 +122,24 @@ class PrimSift prim where
 class PrimDetails prim where
    summarizePrim :: prim wX wY -> [SummDetail]
 
-class PrimShow prim where
-   showPrim :: FileNameFormat -> prim wA wB -> Doc
-   showPrimWithContextAndApply :: ApplyMonad  (ApplyState prim) m => FileNameFormat -> prim wA wB -> m Doc
-
-class PrimRead prim where
-   readPrim :: FileNameFormat -> Parser (Sealed (prim wX))
+showPrimWithContextAndApply
+  :: ( ApplyMonad (ApplyState prim) m
+     , IsHunk prim
+     , ObjectId (ObjectIdOfPatch prim)
+     , Apply prim
+     , ShowPatchBasic prim
+     )
+  => prim wA wB
+  -> m Doc
+showPrimWithContextAndApply p =
+  case isHunk p of
+    Just fh -> do
+      r <- showContextHunk fh
+      apply p
+      return r
+    Nothing -> do
+      apply p
+      return $ showPatch p
 
 class PrimApply prim where
    applyPrimFL :: ApplyMonad (ApplyState prim) m => FL prim wX wY -> m ()
diff --git a/src/Darcs/Patch/Prim/FileUUID.hs b/src/Darcs/Patch/Prim/FileUUID.hs
index ebbbd193..037ad620 100644
--- a/src/Darcs/Patch/Prim/FileUUID.hs
+++ b/src/Darcs/Patch/Prim/FileUUID.hs
@@ -6,11 +6,13 @@ import Darcs.Prelude
 import Darcs.Patch.Prim.FileUUID.Apply ()
 import Darcs.Patch.Prim.FileUUID.Coalesce ()
 import Darcs.Patch.Prim.FileUUID.Commute ()
-import Darcs.Patch.Prim.FileUUID.Core ( Prim )
+import Darcs.Patch.Prim.FileUUID.Core ( Prim, UUID )
 import Darcs.Patch.Prim.FileUUID.Details ()
+import Darcs.Patch.Prim.FileUUID.Format ()
 import Darcs.Patch.Prim.FileUUID.Read ()
-import Darcs.Patch.Prim.FileUUID.Show ()
+import Darcs.Patch.Prim.FileUUID.Show ( showUUID )
 
+import Darcs.Patch.Object ( ObjectId(..) )
 import Darcs.Patch.Prim.Class
   ( PrimMangleUnravelled(..)
   )
@@ -18,3 +20,6 @@ import Darcs.Patch.Prim.Class
 -- dummy implementation
 instance PrimMangleUnravelled Prim where
   mangleUnravelled _ = Nothing
+
+instance ObjectId UUID where
+  showObjectId = showUUID
diff --git a/src/Darcs/Patch/Prim/FileUUID/Apply.hs b/src/Darcs/Patch/Prim/FileUUID/Apply.hs
index 16f62025..9966adf9 100644
--- a/src/Darcs/Patch/Prim/FileUUID/Apply.hs
+++ b/src/Darcs/Patch/Prim/FileUUID/Apply.hs
@@ -15,7 +15,7 @@ import Darcs.Patch.ApplyMonad
     , ApplyMonadOperations
     )
 import Darcs.Patch.Prim.Class ( PrimApply(..) )
-import Darcs.Patch.Prim.FileUUID.Core ( Prim(..), Hunk(..), HunkMove(..) )
+import Darcs.Patch.Prim.FileUUID.Core ( Prim(..), Hunk(..) )
 import Darcs.Patch.Prim.FileUUID.Show
 import Darcs.Patch.Prim.FileUUID.ObjectMap
 import Darcs.Patch.Repair ( RepairToFL(..) )
@@ -29,8 +29,6 @@ instance Apply Prim where
   apply (Manifest i (L dirid name)) = editDirectory dirid (addObject name i dirid)
   apply (Demanifest i (L dirid name)) = editDirectory dirid (delObject name i dirid)
   apply (Hunk i hunk) = editFile i (hunkEdit hunk)
-  apply (HunkMove (HM fs ls ft lt c)) =
-    editFile fs (hunkEdit (H ls c B.empty)) >> editFile ft (hunkEdit (H lt B.empty c))
   apply Identity = return ()
 
 instance RepairToFL Prim where
diff --git a/src/Darcs/Patch/Prim/FileUUID/Coalesce.hs b/src/Darcs/Patch/Prim/FileUUID/Coalesce.hs
index d17fe59d..4c71a091 100644
--- a/src/Darcs/Patch/Prim/FileUUID/Coalesce.hs
+++ b/src/Darcs/Patch/Prim/FileUUID/Coalesce.hs
@@ -1,15 +1,60 @@
-{-# OPTIONS_GHC -Wno-orphans -Wno-missing-methods #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE MultiWayIf #-}
 module Darcs.Patch.Prim.FileUUID.Coalesce () where
 
 import Darcs.Prelude
 
+import qualified Data.ByteString as B
+
 import Darcs.Patch.Prim.Class ( PrimCoalesce(..), PrimSift(..) )
+import Darcs.Patch.Prim.Coalesce ( sortCoalesceFL2, withAnyToMaybe )
 import Darcs.Patch.Prim.FileUUID.Commute ()
-import Darcs.Patch.Prim.FileUUID.Core ( Prim )
+import Darcs.Patch.Prim.FileUUID.Core
+import Darcs.Patch.Witnesses.Eq ( EqCheck(..) )
+import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
 
--- none of the methods are implemented
 instance PrimCoalesce Prim where
-  sortCoalesceFL = id -- just so that we can use it in the tests
+  tryToShrink = withAnyToMaybe . sortCoalesceFL2
+  sortCoalesceFL = snd . sortCoalesceFL2
+  primCoalesce = coalescePair
+  isIdentity Identity = IsEq
+  isIdentity (Hunk _ (H _ old new))
+    | old == new = unsafeCoerceP IsEq
+  isIdentity _ = NotEq
+  comparePrim p1 p2 = compare p1 (unsafeCoerceP p2)
+
+instance PrimSift Prim where
+  primIsSiftable Hunk{} = True
+  primIsSiftable _ = False
+
+coalescePair :: Prim wX wY -> Prim wY wZ -> Maybe (Prim wX wZ)
+coalescePair Identity p = Just p
+coalescePair p Identity = Just p
+coalescePair (Hunk i1 (H l1 o1 n1)) (Hunk i2 (H l2 o2 n2))
+  | i1 == i2 = Hunk i1 <$> coalesceHunk l1 o1 n1 l2 o2 n2
+coalescePair _ _ = Nothing
 
--- none of the methods are implemented
-instance PrimSift Prim
+-- a 1:1 copy of that for V1, only with different types
+coalesceHunk
+  :: Int -> FileContent -> FileContent
+  -> Int -> FileContent -> FileContent
+  -> Maybe (Hunk wX wY)
+coalesceHunk offset1 old1 new1 offset2 old2 new2
+  | offset2 == offset1 =
+    Just $
+    case compare lengthold2 lengthnew1 of
+      LT -> H offset2 old1 (new2 <> B.drop lengthold2 new1)
+      GT -> H offset2 (old1 <> B.drop lengthnew1 old2) new2
+      EQ -> H offset2 old1 new2
+  | offset2 < offset1 && lengthold2 >= offset1 - offset2 =
+    case B.take (offset1 - offset2) old2 of
+      extra ->
+        coalesceHunk offset2 (extra <> old1) (extra <> new1) offset2 old2 new2
+  | offset2 > offset1 && lengthnew1 >= offset2 - offset1 =
+    case B.take (offset2 - offset1) new1 of
+      extra ->
+        coalesceHunk offset1 old1 new1 offset1 (extra <> old2) (extra <> new2)
+  | otherwise = Nothing
+  where
+    lengthold2 = B.length old2
+    lengthnew1 = B.length new1
diff --git a/src/Darcs/Patch/Prim/FileUUID/Commute.hs b/src/Darcs/Patch/Prim/FileUUID/Commute.hs
index a337a9f7..44be830f 100644
--- a/src/Darcs/Patch/Prim/FileUUID/Commute.hs
+++ b/src/Darcs/Patch/Prim/FileUUID/Commute.hs
@@ -15,18 +15,37 @@ import Darcs.Patch.Prim.Class ( primCleanMerge )
 
 -- For FileUUID it is easier to list the cases that do /not/ commute
 depends :: (Prim :> Prim) wX wY -> Bool
-depends (Manifest i1 l1 :> Demanifest i2 l2)
-  -- cannot commute add with remove of same object, regardless of location
-  | i1 == i2 = True
-  -- cannot commute add with remove of any two things at the same location
-  | l1 == l2 = True
+depends (Manifest _i1 l1 :> Demanifest _i2 l2)
+  -- after the first patch, i1 is in location l1, so the second patch can
+  -- only be valid if i1 == i2 => l1 == l2; so this case is redundant:
+  -- | i1 == i2 = True
+  -- cannot commute add with remove of any two things at the same location;
+  -- note that this implies i1 == i2
+  = l1 == l2
 depends (Demanifest i1 l1 :> Manifest i2 l2)
-  -- cannot commute remove with add of same object, regardless of location
+  -- this is effectively a move/rename and does not commute
   | i1 == i2 = True
   -- cannot commute remove with add of any two things at the same location
+  -- (the add depends on the location being empty)
   | l1 == l2 = True
 depends (_ :> _) = False
 
+{-
+-- alternative view:
+conflicts :: (Prim :\/: Prim) wX wY -> Bool
+conflicts (Manifest i1 l1 :\/: Manifest i2 l2)
+  -- cannot add the same object in two different or equal locations
+  -- (the former is invalid, the latter a duplicate); also cannot
+  -- add different objects in the same location
+  = i1 == i2 || l1 == l2
+conflicts (Demanifest i1 l1 :> Demanifest i2 l2)
+  -- the same object cannot be in two different locations, so we have
+  -- i1 == i2 => l1 == l2 (for prims valid in the same context).
+  -- | i1 == i1
+  -- this case implies i1 == i2 and thus is a duplicate
+  = l1 == l2
+-}
+
 instance Commute Prim where
   commute pair
     | depends pair = Nothing
diff --git a/src/Darcs/Patch/Prim/FileUUID/Core.hs b/src/Darcs/Patch/Prim/FileUUID/Core.hs
index 3577c516..78a12b40 100644
--- a/src/Darcs/Patch/Prim/FileUUID/Core.hs
+++ b/src/Darcs/Patch/Prim/FileUUID/Core.hs
@@ -24,7 +24,6 @@
 module Darcs.Patch.Prim.FileUUID.Core
     ( Prim(..)
     , Hunk(..)
-    , HunkMove(..)
     -- re-exports
     , Object(..)
     , UUID(..)
@@ -48,7 +47,7 @@ import Darcs.Patch.Prim.FileUUID.ObjectMap
 -- Hunk
 
 data Hunk wX wY = H !Int !FileContent !FileContent
-  deriving (Eq, Show)
+  deriving (Eq, Ord, Show)
 
 type role Hunk nominal nominal
 
@@ -62,32 +61,17 @@ invertHunk (H off old new) = H off new old
 instance Eq2 Hunk where
   unsafeCompare p q = unsafeCoerceP p == q
 
--- -----------------------------------------------------------------------------
--- HunkMove
-
-data HunkMove wX wY = HM !UUID !Int !UUID !Int !FileContent
-  deriving (Eq, Show)
-
-type role HunkMove nominal nominal
-
-invertHunkMove :: HunkMove wX wY -> HunkMove wY wX
-invertHunkMove (HM sid soff tid toff content) = HM tid toff sid soff content
-
-instance Eq2 HunkMove where
-  unsafeCompare (HM sid1 soff1 tid1 toff1 c1) (HM sid2 soff2 tid2 toff2 c2) =
-    sid1 == sid2 && soff1 == soff2 && tid1 == tid2 && toff1 == toff2 && c1 == c2
-
 -- -----------------------------------------------------------------------------
 -- Prim
 
 data Prim wX wY where
   Hunk :: !UUID -> !(Hunk wX wY) -> Prim wX wY
-  HunkMove :: !(HunkMove wX wY) -> Prim wX wY
   Manifest :: !UUID -> !Location -> Prim wX wY
   Demanifest :: !UUID -> !Location -> Prim wX wY
   Identity :: Prim wX wX
 
 deriving instance Eq (Prim wX wY)
+deriving instance Ord (Prim wX wY)
 deriving instance Show (Prim wX wY)
 
 instance Show1 (Prim wX)
@@ -105,14 +89,14 @@ instance PrimConstruct Prim where
   hunk _ _ _ _ = error "PrimConstruct hunk"
   tokreplace _ _ _ _ = error "PrimConstruct tokreplace"
   binary _ _ _ = error "PrimConstruct binary"
-  primFromHunk _ = error "PrimConstruct primFromHunk"
 
 instance IsHunk Prim where
+  type ExtraData Prim = ()
   isHunk _ = Nothing
+  fromHunk _ = error "PrimConstruct fromHunk"
 
 instance Invert Prim where
   invert (Hunk x h) = Hunk x $ invertHunk h
-  invert (HunkMove hm) = HunkMove $ invertHunkMove hm
   invert (Manifest x y) = Demanifest x y
   invert (Demanifest x y) = Manifest x y
   invert Identity = Identity
diff --git a/src/Darcs/Patch/Prim/FileUUID/Format.hs b/src/Darcs/Patch/Prim/FileUUID/Format.hs
new file mode 100644
index 00000000..38007ff7
--- /dev/null
+++ b/src/Darcs/Patch/Prim/FileUUID/Format.hs
@@ -0,0 +1,62 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Darcs.Patch.Prim.FileUUID.Format ( formatUUID ) where
+
+import Darcs.Prelude
+
+import qualified Data.ByteString as B
+
+import Darcs.Patch.Format ( FormatPatch(..) )
+import Darcs.Patch.Prim.FileUUID.Core
+    ( FileContent
+    , Hunk(..)
+    , Location(..)
+    , Prim(..)
+    , UUID(..)
+    )
+import Darcs.Patch.Prim.FileUUID.ObjectMap ( unFileID )
+import Darcs.Util.Format
+    ( Format
+    , byteString
+    , intDec
+    , ascii
+    , newline
+    , vcat
+    , word64Dec
+    , (<+>)
+    )
+import Darcs.Util.Path ( Name, encodeWhiteName )
+
+instance FormatPatch Prim where
+  formatPatch (Hunk u h) = formatHunk u h
+  formatPatch (Manifest f (L d p)) = formatManifest "manifest" d f p
+  formatPatch (Demanifest f (L d p)) = formatManifest "demanifest" d f p
+  formatPatch Identity = ascii "identity"
+
+formatManifest :: String -> UUID -> UUID -> Name -> Format
+formatManifest txt dir file name =
+  ascii txt <+>
+  formatUUID file <+>
+  formatUUID dir <+>
+  byteString (encodeWhiteName name)
+
+formatHunk :: UUID -> Hunk wX wY -> Format
+formatHunk uid (H off old new) =
+  vcat
+    [ ascii "hunk" <+> formatUUID uid <+> intDec off
+    , formatFileContent old
+    , formatFileContent new
+    ]
+
+formatFileContent :: FileContent -> Format
+formatFileContent c =
+  -- NOTE readPatch wants a '\n' after the length and then starts reading
+  -- content bytes; so clearly using '$$' here would be wrong; but then why
+  -- does it work in the Show module? Apparently, Darcs.Util.Printer is not
+  -- quite as consistent as Darcs.Util.Format when it comes to mempty being
+  -- a unit for $$.
+  ascii "content" <+> intDec (B.length c) <> newline <> byteString c
+
+formatUUID :: UUID -> Format
+formatUUID Root = ascii "root"
+formatUUID (Recorded x) = ascii "r" <+> byteString x
+formatUUID (Unrecorded x) = ascii "u" <+> word64Dec (unFileID x)
diff --git a/src/Darcs/Patch/Prim/FileUUID/ObjectMap.hs b/src/Darcs/Patch/Prim/FileUUID/ObjectMap.hs
index 8ea768ab..7725755b 100644
--- a/src/Darcs/Patch/Prim/FileUUID/ObjectMap.hs
+++ b/src/Darcs/Patch/Prim/FileUUID/ObjectMap.hs
@@ -25,6 +25,7 @@ module Darcs.Patch.Prim.FileUUID.ObjectMap
     , ObjectMap(..), DirContent, FileContent
     , isBlob, isDirectory
     , Name -- re-export
+    , unFileID
     ) where
 
 import Darcs.Prelude
@@ -34,15 +35,24 @@ import Darcs.Util.Hash ( Hash )
 import Darcs.Util.Path ( Name )
 import qualified Data.ByteString as B (ByteString)
 import qualified Data.Map as M
+import Data.Word ( Word64 )
+import System.Posix.Types ( FileID, CIno(..) )
 
 type FileContent = B.ByteString
 
-newtype UUID = UUID B.ByteString deriving (Eq, Ord, Show)
+unFileID :: FileID -> Word64
+unFileID (CIno x) = x
+
+data UUID
+  = Root
+  | Recorded B.ByteString
+  | Unrecorded FileID
+  deriving (Eq, Ord, Show)
 
 -- | An object is located by giving the 'UUID' of the parent
 -- 'Directory' and a 'Name'.
 data Location = L !UUID !Name
-  deriving (Eq, Show)
+  deriving (Eq, Ord, Show)
 
 -- TODO use HashMap instead?
 type DirContent = M.Map Name UUID
diff --git a/src/Darcs/Patch/Prim/FileUUID/Read.hs b/src/Darcs/Patch/Prim/FileUUID/Read.hs
index 9ac236ca..295460aa 100644
--- a/src/Darcs/Patch/Prim/FileUUID/Read.hs
+++ b/src/Darcs/Patch/Prim/FileUUID/Read.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ViewPatterns, OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 module Darcs.Patch.Prim.FileUUID.Read () where
 
@@ -6,8 +6,7 @@ import Darcs.Prelude hiding ( take )
 
 import Control.Monad ( liftM, liftM2 )
 
-import Darcs.Patch.Read ( ReadPatch(..) )
-import Darcs.Patch.Prim.Class( PrimRead(..) )
+import Darcs.Patch.Read ( ReadPatch(..), ReadPatches(..) )
 import Darcs.Patch.Prim.FileUUID.Core( Prim(..), Hunk(..) )
 import Darcs.Patch.Prim.FileUUID.ObjectMap
 import Darcs.Patch.Witnesses.Sealed( seal )
@@ -15,8 +14,8 @@ import Darcs.Patch.Witnesses.Sealed( seal )
 import Darcs.Util.Path ( decodeWhiteName )
 import Darcs.Util.Parser
 
-instance PrimRead Prim where
-  readPrim _ = do
+instance ReadPatch Prim where
+  readPatch' = do
     skipSpace
     choice $ map (liftM seal)
       [ identity
@@ -28,7 +27,12 @@ instance PrimRead Prim where
       manifest kind ctor = liftM2 ctor (patch kind) location
       identity = lexString "identity" >> return Identity
       patch x = string x >> uuid
-      uuid = UUID <$> lexWord
+      uuid =
+        const Root <$> lexString "root"
+        <|>
+        Recorded <$> (lexString "r" >> lexWord)
+        <|>
+        Unrecorded <$> (lexString "u" >> unsigned)
       filename = do
         word <- lexWord
         either fail return $ decodeWhiteName word
@@ -45,5 +49,4 @@ instance PrimRead Prim where
         new <- content
         return $ ctor uid (H offset old new)
 
-instance ReadPatch Prim where
-  readPatch' = readPrim undefined
+instance ReadPatches Prim
diff --git a/src/Darcs/Patch/Prim/FileUUID/Show.hs b/src/Darcs/Patch/Prim/FileUUID/Show.hs
index af3dee44..58af0019 100644
--- a/src/Darcs/Patch/Prim/FileUUID/Show.hs
+++ b/src/Darcs/Patch/Prim/FileUUID/Show.hs
@@ -1,23 +1,24 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# LANGUAGE OverloadedStrings, UndecidableInstances #-}
 module Darcs.Patch.Prim.FileUUID.Show
-    ( displayHunk )
+    ( displayHunk, showUUID )
     where
 
 import Darcs.Prelude
 
 import qualified Data.ByteString as B
 
-import Darcs.Patch.Apply ( Apply(..) )
-import Darcs.Patch.Format ( PatchListFormat, FileNameFormat(..) )
+import Darcs.Patch.Apply ( Apply(..), ObjectIdOfPatch )
+import Darcs.Patch.Object ( ObjectId(..) )
 import Darcs.Patch.Show
     ( ShowPatchBasic(..), ShowPatch(..)
-    , ShowContextPatch(..), ShowPatchFor(..) )
-import Darcs.Patch.Summary ( plainSummaryPrim )
-import Darcs.Patch.Prim.Class ( PrimShow(..) )
+    , ShowContextPatch(..) )
+import Darcs.Patch.Summary ( plainSummaryPrim, plainSummaryPrims )
+import Darcs.Patch.Prim.Class ( showPrimWithContextAndApply )
 import Darcs.Patch.Prim.FileUUID.Core
-    ( Prim(..), Hunk(..), HunkMove(..), UUID(..), Location(..), FileContent )
+    ( Prim(..), Hunk(..), UUID(..), Location(..), FileContent )
 import Darcs.Patch.Prim.FileUUID.Details ()
+import Darcs.Patch.Prim.FileUUID.ObjectMap ()
 import Darcs.Util.ByteString ( linesPS )
 import Darcs.Util.Path ( Name, encodeWhiteName )
 import Darcs.Util.Printer
@@ -25,77 +26,35 @@ import Darcs.Util.Printer
     , (<+>), ($$), Doc, vcat
     )
 
--- TODO this instance shouldn't really be necessary, as Prims aren't used generically
-instance PatchListFormat Prim
-
-fileNameFormat :: ShowPatchFor -> FileNameFormat
-fileNameFormat ForDisplay = FileNameFormatDisplay
-fileNameFormat ForStorage = FileNameFormatV2
-
 instance ShowPatchBasic Prim where
-  showPatch fmt = showPrim (fileNameFormat fmt)
+  showPatch (Hunk u h) = displayHunk (Just u) h
+  showPatch (Manifest f (L d p)) = showManifest "manifest" d f p
+  showPatch (Demanifest f (L d p)) = showManifest "demanifest" d f p
+  showPatch Identity = blueText "identity"
 
--- dummy instance, does not actually show any context
-instance Apply Prim => ShowContextPatch Prim where
-  -- showPatchWithContextAndApply f = showPrimWithContextAndApply (fileNameFormat f)
-  showPatchWithContextAndApply f p = apply p >> return (showPatch f p)
+instance (Apply Prim, ObjectId UUID, ObjectIdOfPatch Prim ~ UUID) => ShowContextPatch Prim where
+  showPatchWithContextAndApply = showPrimWithContextAndApply
 
 instance ShowPatch Prim where
   summary = plainSummaryPrim
-  -- summaryFL = plainSummaryPrims False
+  summaryFL = plainSummaryPrims False
   thing _ = "change"
 
-instance PrimShow Prim where
-  showPrim FileNameFormatDisplay (Hunk u h) = displayHunk (Just u) h
-  showPrim _ (Hunk u h) = storeHunk u h
-  showPrim FileNameFormatDisplay (HunkMove hm) = displayHunkMove hm
-  showPrim _ (HunkMove hm) = storeHunkMove hm
-  showPrim _ (Manifest f (L d p)) = showManifest "manifest" d f p
-  showPrim _ (Demanifest f (L d p)) = showManifest "demanifest" d f p
-  showPrim _ Identity = blueText "identity"
-  showPrimWithContextAndApply _ _ = error "show with context not implemented"
-
 showManifest :: String -> UUID -> UUID -> Name -> Doc
 showManifest txt dir file name =
   blueText txt <+>
-  formatUUID file <+>
-  formatUUID dir <+>
+  showUUID file <+>
+  showUUID dir <+>
   packedString (encodeWhiteName name)
 
 displayHunk :: Maybe UUID -> Hunk wX wY -> Doc
 displayHunk uid (H off old new) =
   blueText "hunk" <+>
-  maybe (text "<nil>") formatUUID uid <+>
+  maybe (text "<nil>") showUUID uid <+>
   text (show off) $$
   displayFileContent "-" old $$
   displayFileContent "+" new
 
-storeHunk :: UUID -> Hunk wX wY -> Doc
-storeHunk uid (H off old new) =
-  text "hunk" <+>
-  formatUUID uid <+>
-  text (show off) $$
-  storeFileContent old $$
-  storeFileContent new
-
-displayHunkMove :: HunkMove wX wY -> Doc
-displayHunkMove (HM sid soff tid toff c) =
-  blueText "hunkmove" <+>
-  formatUUID sid <+>
-  text (show soff) <+>
-  formatUUID tid <+>
-  text (show toff) $$
-  displayFileContent "|" c
-
-storeHunkMove :: HunkMove wX wY -> Doc
-storeHunkMove (HM sid soff tid toff c) =
-  text "hunkmove" <+>
-  formatUUID sid <+>
-  text (show soff) <+>
-  formatUUID tid <+>
-  text (show toff) $$
-  storeFileContent c
-
 -- TODO add some heuristics to recognize binary content
 displayFileContent :: String -> FileContent -> Doc
 displayFileContent pre = vcat . map (prefix pre) . showLines . linesPS
@@ -110,9 +69,7 @@ displayFileContent pre = vcat . map (prefix pre) . showLines . linesPS
       map packedString (init xs) ++
       [packedString (last xs) <> context]
 
-storeFileContent :: FileContent -> Doc
-storeFileContent c =
-  text "content" <+> text (show (B.length c)) $$ packedString c
-
-formatUUID :: UUID -> Doc
-formatUUID (UUID x) = packedString x
+showUUID :: UUID -> Doc
+showUUID Root = "root"
+showUUID (Recorded x) = "r" <+> packedString x
+showUUID (Unrecorded x) = "u" <+> text (show x)
diff --git a/src/Darcs/Patch/Prim/Named.hs b/src/Darcs/Patch/Prim/Named.hs
index 59cb0928..85def9c7 100644
--- a/src/Darcs/Patch/Prim/Named.hs
+++ b/src/Darcs/Patch/Prim/Named.hs
@@ -1,5 +1,6 @@
 -- -fno-cse is here because of anonymousNamedPrim - see the comments on that
 {-# OPTIONS_GHC -fno-cse #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
 -- | Wrapper for prim patches to give them an identity derived from the identity
 -- of the containined Named patch.
 module Darcs.Patch.Prim.Named
@@ -28,10 +29,10 @@ import Darcs.Prelude hiding ( take )
 import Darcs.Patch.Ident ( PatchId, SignedId(..), StorableId(..) )
 import Darcs.Patch.Info ( PatchInfo, makePatchname )
 import Darcs.Patch.Prim.WithName ( PrimWithName(..) )
-import Darcs.Patch.Show ( ShowPatchFor(..) )
 
 import Darcs.Test.TestOnly
 import Darcs.Util.Hash ( SHA1, sha1Show, sha1Read )
+import qualified Darcs.Util.Format as F
 import Darcs.Util.Parser
 import Darcs.Util.Printer
 
@@ -86,10 +87,16 @@ instance StorableId PrimPatchId where
     liftMaybe $ PrimPatchId i <$> sha1Read x
    where
      liftMaybe = maybe mzero return
+  showId = showPrimPatchId
+  formatId (PrimPatchId i h) =
+    F.ascii "hash" F.<+> F.intDec i F.<+> F.byteString (sha1Show h)
 
-  showId ForStorage (PrimPatchId i h) =
-    text "hash" <+> text (show i) <+> packedString (sha1Show h)
-  showId ForDisplay _ = mempty
+instance Print PrimPatchId where
+  print = showPrimPatchId
+
+showPrimPatchId :: PrimPatchId -> Doc
+showPrimPatchId(PrimPatchId i h) =
+  text "hash" <+> text (show i) <+> packedString (sha1Show h)
 
 -- Because we are using unsafePerformIO, we need -fno-cse for
 -- this module. We don't need -fno-full-laziness because the
diff --git a/src/Darcs/Patch/Prim/V1.hs b/src/Darcs/Patch/Prim/V1.hs
index ee1c4888..9d15dbb3 100644
--- a/src/Darcs/Patch/Prim/V1.hs
+++ b/src/Darcs/Patch/Prim/V1.hs
@@ -1,10 +1,11 @@
-module Darcs.Patch.Prim.V1 ( Prim ) where
+module Darcs.Patch.Prim.V1 ( Prim, formatPrim, readPrim ) where
 
 import Darcs.Patch.Prim.V1.Apply ()
 import Darcs.Patch.Prim.V1.Coalesce ()
 import Darcs.Patch.Prim.V1.Commute ()
 import Darcs.Patch.Prim.V1.Core ( Prim )
 import Darcs.Patch.Prim.V1.Details ()
+import Darcs.Patch.Prim.V1.Format ( formatPrim )
 import Darcs.Patch.Prim.V1.Mangle ()
-import Darcs.Patch.Prim.V1.Read ()
+import Darcs.Patch.Prim.V1.Read ( readPrim )
 import Darcs.Patch.Prim.V1.Show ()
diff --git a/src/Darcs/Patch/Prim/V1/Apply.hs b/src/Darcs/Patch/Prim/V1/Apply.hs
index 9beaf1f7..cad31e2b 100644
--- a/src/Darcs/Patch/Prim/V1/Apply.hs
+++ b/src/Darcs/Patch/Prim/V1/Apply.hs
@@ -15,8 +15,10 @@ import Darcs.Patch.Prim.V1.Core
       DirPatchType(..), FilePatchType(..) )
 import Darcs.Patch.Prim.V1.Show ( showHunk )
 
+import Darcs.Patch.Prim.Class ( showPrimWithContextAndApply )
+import Darcs.Patch.Show ( ShowContextPatch(..) )
+
 import Darcs.Util.Path ( AnchoredPath, anchorPath )
-import Darcs.Patch.Format ( FileNameFormat(FileNameFormatDisplay) )
 import Darcs.Patch.TokenReplace ( tryTokReplace )
 
 import Darcs.Patch.ApplyMonad ( ApplyMonadTree(..) )
@@ -143,6 +145,10 @@ instance PrimApply Prim where
               hunkmod _ _ = error "impossible case"
     applyPrimFL (p:>:ps) = apply p >> applyPrimFL ps
 
+
+instance ShowContextPatch Prim where
+  showPatchWithContextAndApply = showPrimWithContextAndApply
+
 applyHunk :: MonadThrow m
           => AnchoredPath
           -> (Int, [B.ByteString], [B.ByteString])
@@ -157,7 +163,7 @@ applyHunk f h fc =
       "\n### to file " ++ ap2fp f ++ ":\n" ++ BC.unpack fc ++
       "### Reason: " ++ msg
   where
-    renderHunk (l, o, n) = renderString (showHunk FileNameFormatDisplay f l o n)
+    renderHunk (l, o, n) = renderString (showHunk f l o n)
 
 {- The way darcs handles newlines is not easy to understand.
 
diff --git a/src/Darcs/Patch/Prim/V1/Commute.hs b/src/Darcs/Patch/Prim/V1/Commute.hs
index 0568bdb5..b825985c 100644
--- a/src/Darcs/Patch/Prim/V1/Commute.hs
+++ b/src/Darcs/Patch/Prim/V1/Commute.hs
@@ -3,13 +3,10 @@ module Darcs.Patch.Prim.V1.Commute () where
 
 import Darcs.Prelude
 
-import Control.Monad ( MonadPlus, msum, mzero, mplus )
-import Control.Applicative ( Alternative(..) )
-
 import qualified Data.ByteString as B ( ByteString )
 import qualified Data.ByteString.Char8 as BC ( pack )
 
-import Darcs.Util.Path ( AnchoredPath, movedirfilename, isPrefix )
+import Darcs.Util.Path ( movedirfilename, isPrefix )
 import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
 import Darcs.Patch.Witnesses.Ordered ( (:>)(..) )
 import Darcs.Patch.Prim.V1.Core
@@ -17,183 +14,94 @@ import Darcs.Patch.Prim.V1.Core
 import Darcs.Patch.Invert ( Invert(..) )
 import Darcs.Patch.Merge ( CleanMerge(..) )
 import Darcs.Patch.Commute ( Commute(..) )
+import Darcs.Patch.CommuteFn ( CommuteFn )
 import Darcs.Patch.Permutations () -- for Invert instance of FL
 import Darcs.Patch.Prim.Class ( primCleanMerge )
 import Darcs.Patch.TokenReplace ( tryTokReplace )
 
-isSuperdir :: AnchoredPath -> AnchoredPath -> Bool
-isSuperdir d1 d2 = isPrefix d1 d2 && d1 /= d2
-
-{-
-This is the original definition.
-Note that it explicitly excludes equality:
-
-isSuperdir d1 d2 = isd (fn2fp d1) (fn2fp d2)
-  where
-    isd s1 s2 =
-      length s2 >= length s1 + 1 && take (length s1 + 1) s2 == s1 ++ "/"
--}
-
-isInDirectory :: AnchoredPath -> AnchoredPath -> Bool
-isInDirectory = isPrefix
-{-
-Again, here is the orginial definition:
-isInDirectory d f = iid (fn2fp d) (fn2fp f)
-    where iid (cd:cds) (cf:cfs)
-              | cd /= cf = False
-              | otherwise = iid cds cfs
-          iid [] ('/':_) = True
-          iid [] [] = True -- Count directory itself as being in directory...
-          iid _ _ = False
--}
-
-data Perhaps a = Unknown | Failed | Succeeded a
-
-instance Functor Perhaps where
-    fmap _ Unknown = Unknown
-    fmap _ Failed = Failed
-    fmap f (Succeeded x) = Succeeded (f x)
-
-instance Applicative Perhaps where
-    pure = Succeeded
-    _ <*> Failed = Failed
-    _ <*> Unknown = Unknown
-    Failed <*> _ = Failed
-    Unknown <*> _ = Unknown
-    Succeeded f <*> Succeeded x = Succeeded (f x)
-
-instance  Monad Perhaps where
-    (Succeeded x) >>= k =  k x
-    Failed   >>= _      =  Failed
-    Unknown  >>= _      =  Unknown
-    return              =  pure
-
-instance Alternative Perhaps where
-    empty = Unknown
-    Unknown <|> ys    = ys
-    Failed  <|> _     = Failed
-    (Succeeded x) <|> _ = Succeeded x
-
-instance  MonadPlus Perhaps where
-    mzero = Unknown
-    mplus = (<|>)
-
-toMaybe :: Perhaps a -> Maybe a
-toMaybe (Succeeded x) = Just x
-toMaybe _ = Nothing
-
-cleverCommute :: CommuteFunction -> CommuteFunction
-cleverCommute c (p1:>p2) =
-    case c (p1 :> p2) of
-    Succeeded x -> Succeeded x
-    Failed -> Failed
-    Unknown -> case c (invert p2 :> invert p1) of
-               Succeeded (p1' :> p2') -> Succeeded (invert p2' :> invert p1')
-               Failed -> Failed
-               Unknown -> Unknown
---cleverCommute c (p1,p2) = c (p1,p2) `mplus`
---    (case c (invert p2,invert p1) of
---     Succeeded (p1', p2') -> Succeeded (invert p2', invert p1')
---     Failed -> Failed
---     Unknown -> Unknown)
+failed :: Maybe a
+failed = Nothing
 
-speedyCommute :: CommuteFunction  -- Deal with common cases quickly!
-    -- Two file-patches modifying different files trivially commute.
-speedyCommute (p1@(FP f1 _) :> p2@(FP f2 _))
-  | f1 /= f2 = Succeeded (unsafeCoerceP p2 :> unsafeCoerceP p1)
-speedyCommute _other = Unknown
+type CommuteFunction p = CommuteFn p p
 
-everythingElseCommute :: CommuteFunction
-everythingElseCommute = eec
-  where
-    eec :: CommuteFunction
-    eec (p1 :> ChangePref p f t) = Succeeded (ChangePref p f t :> unsafeCoerceP p1)
-    eec (ChangePref p f t :> p2) = Succeeded (unsafeCoerceP p2 :> ChangePref p f t)
-    eec xx = cleverCommute commuteFiledir xx
-
-{-
-Note that it must be true that
-
-commutex (A^-1 A, P) = Just (P, A'^-1 A')
-
-and
-
-if commutex (A, B) == Just (B', A')
-then commutex (B^-1, A^-1) == Just (A'^-1, B'^-1)
--}
+-- | Use the invert-commute law.
+invertCommute :: Invert p => CommuteFunction p -> CommuteFunction p
+invertCommute c (p1:>p2) = do
+    ip1' :> ip2' <- c (invert p2 :> invert p1)
+    return (invert ip2' :> invert ip1')
 
 instance Commute Prim where
-    commute x = toMaybe $ msum [speedyCommute x,
-                                everythingElseCommute x
-                               ]
-
-commuteFiledir :: CommuteFunction
-commuteFiledir (FP f1 p1 :> FP f2 p2) =
-  if f1 /= f2 then Succeeded ( FP f2 (unsafeCoerceP p2) :> FP f1 (unsafeCoerceP p1) )
-  else commuteFP f1 (p1 :> p2)
-commuteFiledir (DP d1 p1 :> DP d2 p2) =
-  if not (isInDirectory d1 d2 || isInDirectory d2 d1) && d1 /= d2
-  then Succeeded ( DP d2 (unsafeCoerceP p2) :> DP d1 (unsafeCoerceP p1) )
-  else Failed
-commuteFiledir (FP f fp :> DP d dp) =
-    if not $ isInDirectory d f
-    then Succeeded (DP d (unsafeCoerceP dp) :> FP f (unsafeCoerceP fp))
-    else Failed
-
--- FIXME using isSuperdir here makes no sense, should use just isPrefix
-
+    commute = commuteFiledir
+
+commuteFiledir :: CommuteFunction Prim
+commuteFiledir (FP f1 p1 :> FP f2 p2)
+    | f1 == f2 = do
+        p2' :> p1' <- commuteFP (p1 :> p2)
+        return (FP f2 p2' :> FP f1 p1')
+    | otherwise = return (FP f2 (unsafeCoerceP p2) :> FP f1 (unsafeCoerceP p1))
+commuteFiledir (DP d1 p1 :> DP d2 p2)
+    | isPrefix d1 d2 || isPrefix d2 d1 = failed
+    | otherwise = return (DP d2 (unsafeCoerceP p2) :> DP d1 (unsafeCoerceP p1))
+commuteFiledir (FP f fp :> DP d dp)
+    | isPrefix d f = failed
+    | otherwise = return (DP d (unsafeCoerceP dp) :> FP f (unsafeCoerceP fp))
+commuteFiledir pair@(DP _ _ :> FP _ _) = invertCommute commuteFiledir pair
 commuteFiledir (FP f1 p1 :> Move d d')
-    | f1 == d' = Failed
-    | (p1 == AddFile || p1 == RmFile) && d == f1 = Failed
-    | otherwise = Succeeded (Move d d' :> FP (movedirfilename d d' f1) (unsafeCoerceP p1))
+    | f1 == d' = failed
+    | (p1 == AddFile || p1 == RmFile) && d == f1 = failed
+    | otherwise =
+        return (Move d d' :> FP (movedirfilename d d' f1) (unsafeCoerceP p1))
+commuteFiledir pair@(Move _ _ :> FP _ _) = invertCommute commuteFiledir pair
 commuteFiledir (DP d1 p1 :> Move d d')
-    | isSuperdir d1 d' || isSuperdir d1 d = Failed
-    | d == d1 = Failed  -- The exact guard is p1 == AddDir && d == d1
-                        -- but note d == d1 suffices because we know p1 != RmDir
-                        -- (and hence p1 == AddDir) since patches must be sequential.
-    | d1 == d' = Failed
-    | otherwise = Succeeded (Move d d' :> DP (movedirfilename d d' d1) (unsafeCoerceP p1))
+    | isPrefix d1 d' || isPrefix d1 d = failed
+    | otherwise =
+        return (Move d d' :> DP (movedirfilename d d' d1) (unsafeCoerceP p1))
+commuteFiledir pair@(Move _ _ :> DP _ _) = invertCommute commuteFiledir pair
 commuteFiledir (Move f f' :> Move d d')
-    | f == d' || f' == d = Failed
-    | f == d || f' == d' = Failed
-    | d `isSuperdir` f && f' `isSuperdir` d' = Failed
+    | f == d' || f' == d = failed
+    | f == d || f' == d' = failed
+    | d `isPrefix` f && f' `isPrefix` d' = failed
     | otherwise =
-        Succeeded (Move (movedirfilename f' f d) (movedirfilename f' f d') :>
-                   Move (movedirfilename d d' f) (movedirfilename d d' f'))
-
-commuteFiledir _ = Unknown
-
-type CommuteFunction = forall wX wY . (Prim :> Prim) wX wY -> Perhaps ((Prim :> Prim) wX wY)
-
-commuteFP :: AnchoredPath -> (FilePatchType :> FilePatchType) wX wY
-          -> Perhaps ((Prim :> Prim) wX wY)
-commuteFP f (p1 :> Hunk line1 [] []) =
-    Succeeded (FP f (Hunk line1 [] []) :> FP f (unsafeCoerceP p1))
-commuteFP f (Hunk line1 [] [] :> p2) =
-    Succeeded (FP f (unsafeCoerceP p2) :> FP f (Hunk line1 [] []))
-commuteFP f (Hunk line1 old1 new1 :> Hunk line2 old2 new2) =
+      return
+        (Move (movedirfilename f' f d) (movedirfilename f' f d') :>
+         Move (movedirfilename d d' f) (movedirfilename d d' f'))
+commuteFiledir (p1 :> ChangePref p f t) =
+    return (ChangePref p f t :> unsafeCoerceP p1)
+commuteFiledir (ChangePref p f t :> p2) =
+    return (unsafeCoerceP p2 :> ChangePref p f t)
+
+commuteFP :: CommuteFunction FilePatchType
+commuteFP (p1 :> Hunk line1 [] []) =
+    return (Hunk line1 [] [] :> unsafeCoerceP p1)
+commuteFP (Hunk line1 [] [] :> p2) =
+    return (unsafeCoerceP p2 :> Hunk line1 [] [])
+commuteFP (Hunk line1 old1 new1 :> Hunk line2 old2 new2) =
     case commuteHunkLines line1 (length old1) (length new1) line2 (length old2) (length new2) of
       Just (line2', line1') ->
-        Succeeded (FP f (Hunk line2' old2 new2) :> FP f (Hunk line1' old1 new1))
-      Nothing -> Failed
-commuteFP f (Hunk line1 old1 new1 :> TokReplace t o n) =
+        return (Hunk line2' old2 new2 :> Hunk line1' old1 new1)
+      Nothing -> failed
+commuteFP (Hunk line1 old1 new1 :> TokReplace t o n) =
     let po = BC.pack o; pn = BC.pack n in
     case tryTokReplaces t po pn old1 of
-    Nothing -> Failed
+    Nothing -> failed
     Just old1' ->
       case tryTokReplaces t po pn new1 of
-        Nothing -> Failed
-        Just new1' -> Succeeded (FP f (TokReplace t o n) :>
-                                 FP f (Hunk line1 old1' new1'))
-commuteFP f (TokReplace t1 o1 n1 :> TokReplace t2 o2 n2)
-    | t1 /= t2 = Failed
-    | o1 == o2 = Failed
-    | n1 == o2 = Failed
-    | o1 == n2 = Failed
-    | n1 == n2 = Failed
-    | otherwise = Succeeded (FP f (TokReplace t2 o2 n2) :>
-                             FP f (TokReplace t1 o1 n1))
-commuteFP _ _ = Unknown
+        Nothing -> failed
+        Just new1' -> return (TokReplace t o n :> Hunk line1 old1' new1')
+commuteFP pair@(TokReplace {} :> Hunk {}) = invertCommute commuteFP pair
+commuteFP (TokReplace t1 o1 n1 :> TokReplace t2 o2 n2)
+    | t1 /= t2 = failed
+    | o1 == o2 = failed
+    | n1 == o2 = failed
+    | o1 == n2 = failed
+    | n1 == n2 = failed
+    | otherwise = return (TokReplace t2 o2 n2 :> TokReplace t1 o1 n1)
+commuteFP (AddFile :> _) = failed
+commuteFP (RmFile :> _) = failed
+commuteFP (Binary {} :> _) = failed
+commuteFP (_ :> AddFile) = failed
+commuteFP (_ :> RmFile) = failed
+commuteFP (_ :> Binary {}) = failed
 
 commuteHunkLines :: Int -> Int -> Int -> Int -> Int -> Int
                  -> Maybe (Int, Int)
diff --git a/src/Darcs/Patch/Prim/V1/Core.hs b/src/Darcs/Patch/Prim/V1/Core.hs
index a880d338..32e53d66 100644
--- a/src/Darcs/Patch/Prim/V1/Core.hs
+++ b/src/Darcs/Patch/Prim/V1/Core.hs
@@ -85,11 +85,12 @@ instance ObjectIdOf (ApplyState Prim) ~ AnchoredPath => PrimConstruct Prim where
     hunk f line old new = FP f (Hunk line old new)
     tokreplace f tokchars old new = FP f (TokReplace tokchars old new)
     binary f old new = FP f $ Binary old new
-    primFromHunk (FileHunk f line before after) = FP f (Hunk line before after)
 
 instance ObjectIdOf (ApplyState Prim) ~ AnchoredPath => IsHunk Prim where
-    isHunk (FP f (Hunk line before after)) = Just (FileHunk f line before after)
+    type ExtraData Prim = ()
+    isHunk (FP f (Hunk line before after)) = Just (FileHunk () f line before after)
     isHunk _ = Nothing
+    fromHunk (FileHunk () f line before after) = FP f (Hunk line before after)
 
 instance Invert Prim where
     invert (FP f p)  = FP f (invert p)
diff --git a/src/Darcs/Patch/Prim/V1/Format.hs b/src/Darcs/Patch/Prim/V1/Format.hs
new file mode 100644
index 00000000..1006919d
--- /dev/null
+++ b/src/Darcs/Patch/Prim/V1/Format.hs
@@ -0,0 +1,78 @@
+module Darcs.Patch.Prim.V1.Format (formatPrim) where
+
+import Darcs.Prelude
+
+import qualified Data.ByteString as B (ByteString, length, take, drop)
+
+import Darcs.Patch.Permutations ()
+import Darcs.Patch.Prim.V1.Core ( DirPatchType(..), FilePatchType(..), Prim(..) )
+
+import Darcs.Util.Format
+import Darcs.Util.Path ( AnchoredPath )
+
+
+formatPrim :: (AnchoredPath -> Format) -> Prim wX wY -> Format
+formatPrim fmt (FP f AddFile) = ascii "addfile" <+> fmt f
+formatPrim fmt (FP f RmFile) = ascii "rmfile" <+> fmt f
+formatPrim fmt (FP f (Hunk line old new)) = formatHunk fmt f line old new
+formatPrim fmt (FP f (TokReplace t old new)) = formatTok fmt f t old new
+formatPrim fmt (FP f (Binary old new)) = formatBinary fmt f old new
+formatPrim fmt (DP d AddDir) = ascii "adddir" <+> fmt d
+formatPrim fmt (DP d RmDir) = ascii "rmdir" <+> fmt d
+formatPrim fmt (Move f f') = ascii "move" <+> fmt f <+> fmt f'
+formatPrim _ (ChangePref p f t) =
+  ascii "changepref" <+> ascii p <>
+  -- Note that '$$' is not correct here, since read expects both values to
+  -- be terminated by a newline (or EOF). For a similar situation see
+  -- Darcs.Patch.Prim.FileUUID.Format.formatFileContent
+  newline <> userchunk f <> newline <> userchunk t
+
+formatHunk
+  :: (AnchoredPath -> Format)
+  -> AnchoredPath
+  -> Int
+  -> [B.ByteString]
+  -> [B.ByteString]
+  -> Format
+formatHunk fmt f line old new =
+  vcat
+    [ ascii "hunk" <+> fmt f <+> intDec line
+    , vcat (map (format_line "-") old)
+    , vcat (map (format_line "+") new)
+    ]
+  where
+    format_line pre bs = ascii pre <> byteString bs
+
+formatTok
+  :: (AnchoredPath -> Format)
+  -> AnchoredPath
+  -> String
+  -> String
+  -> String
+  -> Format
+formatTok fmt f t o n =
+  ascii "replace"
+    <+> fmt f
+    <+> ascii "[" <> userchunk t <> ascii "]"
+    <+> userchunk o
+    <+> userchunk n
+
+formatBinary
+  :: (AnchoredPath -> Format)
+  -> AnchoredPath
+  -> B.ByteString
+  -> B.ByteString
+  -> Format
+formatBinary fmt f old new =
+  vcat
+    [ ascii "binary" <+> fmt f
+    , ascii "oldhex"
+    , vcat (map format_chunk $ breakEvery 39 old)
+    , ascii "newhex"
+    , vcat (map format_chunk $ breakEvery 39 new)
+    ]
+  where
+    format_chunk bs = ascii "*" <> byteStringHex bs
+    breakEvery n ps
+      | B.length ps < n = [ps]
+      | otherwise = B.take n ps : breakEvery n (B.drop n ps)
diff --git a/src/Darcs/Patch/Prim/V1/Mangle.hs b/src/Darcs/Patch/Prim/V1/Mangle.hs
index 2320b8da..ed8dc08e 100644
--- a/src/Darcs/Patch/Prim/V1/Mangle.hs
+++ b/src/Darcs/Patch/Prim/V1/Mangle.hs
@@ -14,10 +14,7 @@ import Darcs.Patch.Apply ( ObjectIdOfPatch )
 import Darcs.Patch.FileHunk ( FileHunk(..), IsHunk(..) )
 import Darcs.Patch.Inspect ( PatchInspect(listTouchedFiles) )
 import Darcs.Patch.Invert ( Invert(..) )
-import Darcs.Patch.Prim.Class
-    ( PrimConstruct(primFromHunk)
-    , PrimMangleUnravelled(..)
-    )
+import Darcs.Patch.Prim.Class ( PrimMangleUnravelled(..) )
 import Darcs.Patch.Prim.V1.Core ( Prim )
 import Darcs.Patch.Prim.V1.Apply ()
 import Darcs.Patch.Witnesses.Ordered ( FL(..), (+>+), mapFL_FL_M )
@@ -33,8 +30,8 @@ unknownFileState = FileState (repeat Nothing)
 
 -- | Note that @applyHunk p . applyHunk (invert p) /= id@: it converts
 -- undefined lines ('Nothing') to defined ones ('Just' the old content of @p@).
-applyHunk :: FileHunk oid wX wY -> FileState wX -> FileState wY
-applyHunk (FileHunk _ line old new) = FileState . go . content
+applyHunk :: FileHunk xd oid wX wY -> FileState wX -> FileState wY
+applyHunk (FileHunk _ _ line old new) = FileState . go . content
   where
     go mls =
       case splitAt (line - 1) mls of
@@ -42,35 +39,39 @@ applyHunk (FileHunk _ line old new) = FileState . go . content
           concat [before, map Just new, drop (length old) rest]
 
 -- | Iterate 'applyHunk'.
-applyHunks :: FL (FileHunk oid) wX wY -> FileState wX -> FileState wY
+applyHunks :: FL (FileHunk xd oid) wX wY -> FileState wX -> FileState wY
 applyHunks NilFL = id
 applyHunks (p:>:ps) = applyHunks ps . applyHunk p
 
-
+-- TODO The only remaining dependency on Prim.V1 is the constraint
+-- ExtraData prim ~ (). We should generalize it so we can make use of the
+-- ExtraData that isHunk for Prim.Named puts in there, i.e. mangle the
+-- PrimPatchIds and show them in the conflict markup.
 instance PrimMangleUnravelled Prim where
   mangleUnravelled pss = do
       hunks <- onlyHunks pss
       filename <- listToMaybe (filenames pss)
-      return $ mapSeal ((:>: NilFL) . primFromHunk) $ mangleHunks filename hunks
+      return $ mapSeal ((:>: NilFL) . fromHunk) $ mangleHunks filename hunks
     where
       -- | The names of all touched files.
       filenames = nub . concatMap (unseal listTouchedFiles)
 
       -- | Convert every prim in the input to a 'FileHunk', or fail.
-      onlyHunks :: forall prim oid wX. (IsHunk prim, ObjectIdOfPatch prim ~ oid)
-                => [Sealed (FL prim wX)]
-                -> Maybe [Sealed (FL (FileHunk oid) wX)]
+      onlyHunks
+        :: IsHunk prim
+        => [Sealed (FL prim wX)]
+        -> Maybe [Sealed (FL (FileHunk (ExtraData prim) (ObjectIdOfPatch prim)) wX)]
       onlyHunks = mapM toHunk where
-        toHunk :: Sealed (FL prim wA) -> Maybe (Sealed (FL (FileHunk oid) wA))
         toHunk (Sealed ps) = fmap Sealed $ mapFL_FL_M isHunk ps
 
       -- | Mangle a list of hunks, returning a single hunk.
       -- Note: the input list consists of 'FL's because when commuting conflicts
       -- to the head we may accumulate dependencies. In fact, the patches in all
       -- of the given (mutually conflicting) 'FL's should coalesce to a single hunk.
-      mangleHunks :: oid -> [Sealed (FL (FileHunk oid) wX)] -> Sealed (FileHunk oid wX)
+      mangleHunks
+        :: oid -> [Sealed (FL (FileHunk () oid) wX)] -> Sealed (FileHunk () oid wX)
       mangleHunks _ [] = error "mangleHunks called with empty list of alternatives"
-      mangleHunks path ps = Sealed (FileHunk path l old new)
+      mangleHunks oid ps = Sealed (FileHunk () oid l old new)
         where
           oldf    = foldl oldFileState unknownFileState ps
           newfs   = map (newFileState oldf) ps
@@ -90,11 +91,11 @@ instance PrimMangleUnravelled Prim where
 
       -- | Apply the patches and their inverse. This turns all lines touched
       -- by the 'FL' of patches into defined lines with their "old" values.
-      oldFileState :: FileState wX -> Sealed (FL (FileHunk oid) wX) -> FileState wX
+      oldFileState :: FileState wX -> Sealed (FL (FileHunk xd oid) wX) -> FileState wX
       oldFileState mls (Sealed ps) = applyHunks (ps +>+ invert ps) mls
 
       -- | This is @flip 'applyHunks'@ under 'Sealed'.
-      newFileState :: FileState wX -> Sealed (FL (FileHunk oid) wX) -> Sealed FileState
+      newFileState :: FileState wX -> Sealed (FL (FileHunk xd oid) wX) -> Sealed FileState
       newFileState mls (Sealed ps) = Sealed (applyHunks ps mls)
 
       -- Index of the first line touched by any of the FileStates (1-based).
diff --git a/src/Darcs/Patch/Prim/V1/Read.hs b/src/Darcs/Patch/Prim/V1/Read.hs
index 78990c08..9cad6695 100644
--- a/src/Darcs/Patch/Prim/V1/Read.hs
+++ b/src/Darcs/Patch/Prim/V1/Read.hs
@@ -1,9 +1,8 @@
-{-# OPTIONS_GHC -Wno-orphans #-}
-module Darcs.Patch.Prim.V1.Read () where
+module Darcs.Patch.Prim.V1.Read (readPrim) where
 
 import Darcs.Prelude
 
-import Darcs.Patch.Prim.Class ( PrimRead(..), hunk, binary )
+import Darcs.Patch.Prim.Class ( hunk, binary )
 import Darcs.Patch.Prim.V1.Core
     ( Prim(..)
     , DirPatchType(..)
@@ -11,39 +10,46 @@ import Darcs.Patch.Prim.V1.Core
     )
 import Darcs.Patch.Prim.V1.Apply ()
 
-import Darcs.Util.Path (  )
-import Darcs.Patch.Format ( FileNameFormat )
-import Darcs.Patch.Read ( readFileName )
 import Darcs.Util.Parser
     ( Parser, takeTillChar, string, int
     , option, choice, anyChar, char, lexWord
     , skipSpace, skipWhile, linesStartingWith
     )
 
-import Darcs.Patch.Witnesses.Sealed ( seal )
+import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
 
-import Darcs.Util.ByteString ( fromHex2PS )
+import Darcs.Util.ByteString ( decodeLocale, fromHex2PS )
+import Darcs.Util.Path ( AnchoredPath )
 
-import Control.Monad ( liftM )
 import qualified Data.ByteString       as B  ( ByteString, init, tail, concat )
-import qualified Data.ByteString.Char8 as BC ( unpack, pack )
-
-
-instance PrimRead Prim where
-  readPrim fmt
-     = skipSpace >> choice
-       [ return' $ readHunk fmt
-       , return' $ readAddFile fmt
-       , return' $ readAddDir fmt
-       , return' $ readMove fmt
-       , return' $ readRmFile fmt
-       , return' $ readRmDir fmt
-       , return' $ readTok fmt
-       , return' $ readBinary fmt
-       , return' readChangePref
-       ]
-    where
-    return'  = liftM seal
+import qualified Data.ByteString.Char8 as BC ( unpack, pack, stripPrefix )
+
+
+type DecodePath = B.ByteString -> Either String AnchoredPath
+
+readFilePath :: DecodePath -> Parser AnchoredPath
+readFilePath decodePath = do
+  raw <- lexWord
+  case BC.stripPrefix (BC.pack "./") raw of
+    Nothing -> fail $ "invalid file path"
+    Just raw' ->
+      case decodePath raw' of
+        Left e -> fail e
+        Right r -> return r
+
+readPrim :: DecodePath -> Parser (Sealed (Prim wX))
+readPrim fmt =
+  skipSpace >> choice
+    [ Sealed <$> readHunk fmt
+    , Sealed <$> readAddFile fmt
+    , Sealed <$> readAddDir fmt
+    , Sealed <$> readMove fmt
+    , Sealed <$> readRmFile fmt
+    , Sealed <$> readRmDir fmt
+    , Sealed <$> readTok fmt
+    , Sealed <$> readBinary fmt
+    , Sealed <$> readChangePref
+    ]
 
 hunk' :: B.ByteString
 hunk' = BC.pack "hunk"
@@ -72,10 +78,10 @@ move = BC.pack "move"
 changepref :: B.ByteString
 changepref = BC.pack "changepref"
 
-readHunk :: FileNameFormat -> Parser (Prim wX wY)
+readHunk :: DecodePath -> Parser (Prim wX wY)
 readHunk fmt = do
   string hunk'
-  fi <- readFileName fmt
+  fi <- readFilePath fmt
   l <- int
   have_nl <- skipNewline
   if have_nl
@@ -90,10 +96,10 @@ readHunk fmt = do
 skipNewline :: Parser Bool
 skipNewline = option False (char '\n' >> return True)
 
-readTok :: FileNameFormat -> Parser (Prim wX wY)
+readTok :: DecodePath -> Parser (Prim wX wY)
 readTok fmt = do
   string replace
-  f <- readFileName fmt
+  f <- readFilePath fmt
   regstr <- lexWord
   o <- lexWord
   n <- lexWord
@@ -113,10 +119,10 @@ readTok fmt = do
 -- > newhex
 -- > *HEXHEXHEX
 -- > ...
-readBinary :: FileNameFormat -> Parser (Prim wX wY)
+readBinary :: DecodePath -> Parser (Prim wX wY)
 readBinary fmt = do
   string binary'
-  fi <- readFileName fmt
+  fi <- readFilePath fmt
   _ <- lexWord
   skipSpace
   old <- linesStartingWith '*'
@@ -127,23 +133,23 @@ readBinary fmt = do
   r_new <- either fail return $ fromHex2PS $ B.concat new
   return $ binary fi r_old r_new
 
-readAddFile :: FileNameFormat -> Parser (Prim wX wY)
+readAddFile :: DecodePath -> Parser (Prim wX wY)
 readAddFile fmt = do
   string addfile
-  f <- readFileName fmt
+  f <- readFilePath fmt
   return $ FP f AddFile
 
-readRmFile :: FileNameFormat -> Parser (Prim wX wY)
+readRmFile :: DecodePath -> Parser (Prim wX wY)
 readRmFile fmt = do
   string rmfile
-  f <- readFileName fmt
+  f <- readFilePath fmt
   return $ FP f RmFile
 
-readMove :: FileNameFormat -> Parser (Prim wX wY)
+readMove :: DecodePath -> Parser (Prim wX wY)
 readMove fmt = do
   string move
-  d <- readFileName fmt
-  d' <- readFileName fmt
+  d <- readFilePath fmt
+  d' <- readFilePath fmt
   return $ Move d d'
 
 readChangePref :: Parser (Prim wX wY)
@@ -155,16 +161,16 @@ readChangePref = do
   f <- takeTillChar '\n'
   _ <- anyChar -- skip newline
   t <- takeTillChar '\n'
-  return $ ChangePref (BC.unpack p) (BC.unpack f) (BC.unpack t)
+  return $ ChangePref (BC.unpack p) (decodeLocale f) (decodeLocale t)
 
-readAddDir :: FileNameFormat -> Parser (Prim wX wY)
+readAddDir :: DecodePath -> Parser (Prim wX wY)
 readAddDir fmt = do
   string adddir
-  f <- readFileName fmt
+  f <- readFilePath fmt
   return $ DP f AddDir
 
-readRmDir :: FileNameFormat -> Parser (Prim wX wY)
+readRmDir :: DecodePath -> Parser (Prim wX wY)
 readRmDir fmt = do
   string rmdir
-  f <- readFileName fmt
+  f <- readFilePath fmt
   return $ DP f RmDir
diff --git a/src/Darcs/Patch/Prim/V1/Show.hs b/src/Darcs/Patch/Prim/V1/Show.hs
index d65832a8..36b22e24 100644
--- a/src/Darcs/Patch/Prim/V1/Show.hs
+++ b/src/Darcs/Patch/Prim/V1/Show.hs
@@ -9,25 +9,25 @@ import Darcs.Prelude
 import Darcs.Util.ByteString ( fromPS2Hex )
 import qualified Data.ByteString as B (ByteString, length, take, drop)
 
-import Darcs.Patch.Apply ( Apply(..), ObjectIdOfPatch )
 import Darcs.Patch.FileHunk ( FileHunk(..), showFileHunk )
-import Darcs.Patch.Format ( FileNameFormat )
-import Darcs.Patch.Show ( formatFileName )
-import Darcs.Patch.Permutations () -- for Invert instance of FL
-import Darcs.Patch.Prim.Class ( PrimShow(..) )
-import Darcs.Patch.Prim.V1.Core
-     ( Prim(..), FilePatchType(..), DirPatchType(..) )
+import Darcs.Patch.Permutations ()
+import Darcs.Patch.Prim.V1.Core ( DirPatchType(..), FilePatchType(..), Prim(..) )
 import Darcs.Patch.Prim.V1.Details ()
-import Darcs.Patch.Viewing ( showContextHunk )
+import Darcs.Patch.Show ( ShowPatchBasic(..) )
 import Darcs.Patch.Witnesses.Show ( Show1, Show2 )
 
-import Darcs.Util.Path ( AnchoredPath )
-import Darcs.Util.Printer ( Doc, vcat,
-                 text, userchunk, invisibleText, invisiblePS, blueText,
-                 ($$), (<+>)
-               )
-import Darcs.Util.Tree ( Tree )
-
+import Darcs.Util.Path ( AnchoredPath, anchorPath )
+import Darcs.Util.Printer
+    ( Doc
+    , blueText
+    , invisiblePS
+    , invisibleText
+    , text
+    , userchunk
+    , vcat
+    , ($$)
+    , (<+>)
+    )
 
 instance Show2 Prim
 instance Show1 (Prim wX)
@@ -35,57 +35,49 @@ deriving instance Show (Prim wX wY)
 deriving instance Show (FilePatchType wX wY)
 deriving instance Show (DirPatchType wX wY)
 
-instance (Apply Prim, ApplyState Prim ~ Tree, ObjectIdOfPatch Prim ~ AnchoredPath) =>
-         PrimShow Prim where
-  showPrim fmt (FP f AddFile) = showAddFile fmt f
-  showPrim fmt (FP f RmFile)  = showRmFile fmt f
-  showPrim fmt (FP f (Hunk line old new))  = showHunk fmt f line old new
-  showPrim fmt (FP f (TokReplace t old new))  = showTok fmt f t old new
-  showPrim fmt (FP f (Binary old new))  = showBinary fmt f old new
-  showPrim fmt (DP d AddDir) = showAddDir fmt d
-  showPrim fmt (DP d RmDir)  = showRmDir fmt d
-  showPrim fmt (Move f f') = showMove fmt f f'
-  showPrim _ (ChangePref p f t) = showChangePref p f t
-  showPrimWithContextAndApply fmt p@(FP f (Hunk line old new)) = do
-    r <- showContextHunk fmt (FileHunk f line old new)
-    apply p
-    return r
-  showPrimWithContextAndApply fmt p = do
-    apply p
-    return $ showPrim fmt p
-
-showAddFile :: FileNameFormat -> AnchoredPath -> Doc
-showAddFile fmt f = blueText "addfile" <+> formatFileName fmt f
-
-showRmFile :: FileNameFormat -> AnchoredPath -> Doc
-showRmFile fmt f = blueText "rmfile" <+> formatFileName fmt f
-
-showMove :: FileNameFormat -> AnchoredPath -> AnchoredPath -> Doc
-showMove fmt d d' = blueText "move" <+> formatFileName fmt d <+> formatFileName fmt d'
+instance ShowPatchBasic Prim where
+  showPatch (FP f AddFile) = showAddFile f
+  showPatch (FP f RmFile)  = showRmFile f
+  showPatch (FP f (Hunk line old new))  = showHunk f line old new
+  showPatch (FP f (TokReplace t old new))  = showTok f t old new
+  showPatch (FP f (Binary old new))  = showBinary f old new
+  showPatch (DP d AddDir) = showAddDir d
+  showPatch (DP d RmDir)  = showRmDir d
+  showPatch (Move f f') = showMove f f'
+  showPatch (ChangePref p f t) = showChangePref p f t
+
+showAddFile :: AnchoredPath -> Doc
+showAddFile f = blueText "addfile" <+> showFileName f
+
+showRmFile :: AnchoredPath -> Doc
+showRmFile f = blueText "rmfile" <+> showFileName f
+
+showMove :: AnchoredPath -> AnchoredPath -> Doc
+showMove d d' = blueText "move" <+> showFileName d <+> showFileName d'
 
 showChangePref :: String -> String -> String -> Doc
 showChangePref p f t = blueText "changepref" <+> text p
                     $$ userchunk f
                     $$ userchunk t
 
-showAddDir :: FileNameFormat -> AnchoredPath -> Doc
-showAddDir fmt d = blueText "adddir" <+> formatFileName fmt d
+showAddDir :: AnchoredPath -> Doc
+showAddDir d = blueText "adddir" <+> showFileName d
 
-showRmDir :: FileNameFormat -> AnchoredPath -> Doc
-showRmDir fmt d = blueText "rmdir" <+> formatFileName fmt d
+showRmDir :: AnchoredPath -> Doc
+showRmDir d = blueText "rmdir" <+> showFileName d
 
-showHunk :: FileNameFormat -> AnchoredPath -> Int -> [B.ByteString] -> [B.ByteString] -> Doc
-showHunk fmt f line old new = showFileHunk fmt (FileHunk f line old new)
+showHunk :: AnchoredPath -> Int -> [B.ByteString] -> [B.ByteString] -> Doc
+showHunk f line old new = showFileHunk (FileHunk () f line old new)
 
-showTok :: FileNameFormat -> AnchoredPath -> String -> String -> String -> Doc
-showTok fmt f t o n = blueText "replace" <+> formatFileName fmt f
+showTok :: AnchoredPath -> String -> String -> String -> Doc
+showTok f t o n = blueText "replace" <+> showFileName f
                                      <+> text "[" <> userchunk t <> text "]"
                                      <+> userchunk o
                                      <+> userchunk n
 
-showBinary :: FileNameFormat -> AnchoredPath -> B.ByteString -> B.ByteString -> Doc
-showBinary fmt f o n =
-    blueText "binary" <+> formatFileName fmt f
+showBinary :: AnchoredPath -> B.ByteString -> B.ByteString -> Doc
+showBinary f o n =
+    blueText "binary" <+> showFileName f
  $$ invisibleText "oldhex"
  $$ vcat (map makeprintable $ breakEvery 78 $ fromPS2Hex o)
  $$ invisibleText "newhex"
@@ -95,3 +87,6 @@ showBinary fmt f o n =
 breakEvery :: Int -> B.ByteString -> [B.ByteString]
 breakEvery n ps | B.length ps < n = [ps]
                  | otherwise = B.take n ps : breakEvery n (B.drop n ps)
+
+showFileName :: AnchoredPath -> Doc
+showFileName = text . anchorPath "."
diff --git a/src/Darcs/Patch/Prim/WithName.hs b/src/Darcs/Patch/Prim/WithName.hs
index 60f7c4ec..559608d8 100644
--- a/src/Darcs/Patch/Prim/WithName.hs
+++ b/src/Darcs/Patch/Prim/WithName.hs
@@ -8,7 +8,7 @@ import Darcs.Prelude
 import Darcs.Patch.Annotate ( Annotate(..) )
 import Darcs.Patch.Apply ( Apply(..) )
 import Darcs.Patch.Commute ( Commute(..) )
-import Darcs.Patch.Format ( PatchListFormat(..) )
+import Darcs.Patch.Format ( FormatPatch(..) )
 import Darcs.Patch.Ident
     ( Ident(..)
     , PatchId
@@ -16,11 +16,11 @@ import Darcs.Patch.Ident
     , StorableId(..)
     )
 import Darcs.Patch.Inspect ( PatchInspect(..) )
-import Darcs.Patch.FileHunk ( IsHunk(..) )
+import Darcs.Patch.FileHunk ( IsHunk(..), FileHunk(..) )
 import Darcs.Patch.Prim.Class ( PrimApply(..), PrimDetails(..) )
 import Darcs.Patch.Invert ( Invert(..) )
 import Darcs.Patch.Merge ( CleanMerge(..) )
-import Darcs.Patch.Read ( ReadPatch(..) )
+import Darcs.Patch.Read ( ReadPatch(..), ReadPatches(..) )
 import Darcs.Patch.Repair ( RepairToFL(..) )
 import Darcs.Patch.Show
     ( ShowPatchBasic(..)
@@ -34,6 +34,7 @@ import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
 import Darcs.Patch.Witnesses.Show ( Show1, Show2, appPrec, showsPrec2 )
 
 import Darcs.Util.Printer
+import qualified Darcs.Util.Format as F
 
 -- |A 'PrimWithName' is a general way of associating an identity
 -- with an underlying (presumably unnamed) primitive type. This is
@@ -78,16 +79,19 @@ instance Apply p => Apply (PrimWithName name p) where
   apply = apply . wnPatch
   unapply = unapply . wnPatch
 
-instance PatchListFormat (PrimWithName name p)
-
 instance Apply p => RepairToFL (PrimWithName name p) where
   applyAndTryToFixFL p = apply p >> return Nothing
 
 instance Annotate p => Annotate (PrimWithName name p) where
   annotate = annotate . wnPatch
 
-instance IsHunk p => IsHunk (PrimWithName name p) where
-  isHunk = isHunk . wnPatch
+instance (IsHunk p, Print name) => IsHunk (PrimWithName name p) where
+  type ExtraData (PrimWithName name p) = (name, ExtraData p)
+  isHunk (PrimWithName name p) = do
+    FileHunk xd oid l n o <- isHunk p
+    return $ FileHunk (name, xd) oid l n o
+  fromHunk (FileHunk (name, xd) oid l n o) =
+    PrimWithName name (fromHunk (FileHunk xd oid l n o))
 
 instance PrimApply p => PrimApply (PrimWithName name p) where
   applyPrimFL = applyPrimFL . mapFL_FL wnPatch
@@ -122,15 +126,23 @@ instance (StorableId name, ReadPatch p) => ReadPatch (PrimWithName name p) where
       Sealed p <- readPatch'
       return (Sealed (PrimWithName name p))
 
+instance (StorableId name, ReadPatch p) => ReadPatches (PrimWithName name p)
+
 instance (StorableId name, ShowPatchBasic p) => ShowPatchBasic (PrimWithName name p) where
-  showPatch use (PrimWithName name p) = showId use name $$ showPatch use p
+  showPatch (PrimWithName name p) = showId name $$ showPatch p
+
+instance (StorableId name, FormatPatch p) => FormatPatch (PrimWithName name p) where
+  formatPatch (PrimWithName name p) = formatId name F.$$ formatPatch p
 
-instance (StorableId name, PrimDetails p, ShowPatchBasic p) => ShowPatch (PrimWithName name p) where
+instance (StorableId name, PrimDetails p, ShowPatch p) => ShowPatch (PrimWithName name p) where
+  content = content . wnPatch
+  description = description . wnPatch
   summary = plainSummaryPrim . wnPatch
   summaryFL = plainSummaryPrims False
-  thing _ = "change"
+  thing = thing . wnPatch
+  things = things . wnPatch
 
 instance (StorableId name, ShowContextPatch p) => ShowContextPatch (PrimWithName name p) where
-  showPatchWithContextAndApply use (PrimWithName name p) = do
-    r <- showPatchWithContextAndApply use p
-    return $ showId use name $$ r
+  showPatchWithContextAndApply (PrimWithName name p) = do
+    r <- showPatchWithContextAndApply p
+    return $ showId name $$ r
diff --git a/src/Darcs/Patch/Read.hs b/src/Darcs/Patch/Read.hs
index 52dea5a0..413d7e4f 100644
--- a/src/Darcs/Patch/Read.hs
+++ b/src/Darcs/Patch/Read.hs
@@ -17,46 +17,57 @@
 
 module Darcs.Patch.Read
     ( ReadPatch(..)
+    , ReadPatches(..)
     , readPatch
+    , readPatchFL
+    , standardReadPatchFL'
+    , legacyReadPatchFL'
     , readPatchPartial
-    , bracketedFL
-    , peekfor
-    , readFileName
+    , readBracketedFL
     ) where
 
 import Darcs.Prelude
 
 import Control.Applicative ( (<|>) )
-import Control.Monad ( mzero, (<=<) )
 import qualified Data.ByteString as B ( ByteString )
-import qualified Data.ByteString.Char8 as BC ( ByteString, pack, stripPrefix )
-import GHC.Stack ( HasCallStack )
 
 import Darcs.Patch.Bracketed ( Bracketed(..), unBracketedFL )
-import Darcs.Patch.Format
-    ( FileNameFormat(..)
-    , ListFormat(..)
-    , PatchListFormat(..)
-    )
 import Darcs.Util.Parser
     ( Parser
     , checkConsumes
-    , choice
     , lexChar
-    , lexString
-    , lexWord
     , parse
     , parseAll
     )
-import Darcs.Patch.Witnesses.Ordered ( FL(..), RL, reverseFL )
+import Darcs.Patch.Witnesses.Ordered ( FL(..) )
 import Darcs.Patch.Witnesses.Sealed ( Sealed(..), mapSeal )
 
-import Darcs.Util.ByteString ( decodeLocale, unpackPSFromUTF8 )
-import Darcs.Util.Path ( AnchoredPath, decodeWhite, floatPath )
 
 -- | This class is used to decode patches from their binary representation.
 class ReadPatch p where
-    readPatch' :: Parser (Sealed (p wX))
+  readPatch' :: Parser (Sealed (p wX))
+
+class ReadPatch p => ReadPatches p where
+  readPatchFL' :: Parser (Sealed (FL p wX))
+  readPatchFL' = standardReadPatchFL'
+
+-- | Read a sequence of patches with optional (arbitrarily nested, round or
+-- curly) bracketing.
+legacyReadPatchFL' :: ReadPatch p => Parser (Sealed (FL p wX))
+-- This is slightly tricky. Note how the standardReadPatchFL' here reads
+-- a plain (unbracketed) sequence of zero or more Bracketed patches.
+legacyReadPatchFL' = mapSeal unBracketedFL <$> standardReadPatchFL'
+
+standardReadPatchFL' :: ReadPatch p => Parser (Sealed (FL p wX))
+standardReadPatchFL' = do
+  -- checkConsumes is needed to make sure that something is read,
+  -- to avoid stack overflow when parsing FL (FL p)
+  mp <- (Just <$> checkConsumes readPatch') <|> return Nothing
+  case mp of
+    Just (Sealed p) -> do
+      Sealed ps <- standardReadPatchFL'
+      return $ Sealed (p :>: ps)
+    Nothing -> return $ Sealed NilFL
 
 readPatchPartial :: ReadPatch p => B.ByteString -> Either String (Sealed (p wX), B.ByteString)
 readPatchPartial = parse readPatch'
@@ -64,74 +75,34 @@ readPatchPartial = parse readPatch'
 readPatch :: ReadPatch p => B.ByteString -> Either String (Sealed (p wX))
 readPatch = parseAll readPatch'
 
+readPatchFL :: ReadPatches p => B.ByteString -> Either String (Sealed (FL p wX))
+readPatchFL = parseAll readPatchFL'
+
 instance ReadPatch p => ReadPatch (Bracketed p) where
-    readPatch' = mapSeal Braced <$> bracketedFL readPatch' '{' '}'
+    readPatch' = mapSeal Braced <$> readBracketedFL readPatch' '{' '}'
                    <|>
-                 mapSeal Parens <$> bracketedFL readPatch' '(' ')'
+                 mapSeal Parens <$> readBracketedFL readPatch' '(' ')'
                    <|>
                  mapSeal Singleton <$> readPatch'
 
-instance (ReadPatch p, PatchListFormat p) => ReadPatch (FL p) where
-    readPatch'
-        | ListFormatV1 <- patchListFormat :: ListFormat p
-            = mapSeal unBracketedFL <$> readPatch'
-        -- in the V2 format case, we only need to support () on reading, not {}
-        -- for simplicity we just go through the same code path.
-        | ListFormatV2 <- patchListFormat :: ListFormat p
-            = mapSeal unBracketedFL <$> readPatch'
-        | otherwise
-            = read_patches
-     where read_patches :: Parser (Sealed (FL p wX))
-           read_patches = do --tracePeek "starting FL read"
-                             -- checkConsumes is needed to make sure that something is read,
-                             -- to avoid stack overflow when parsing FL (FL p)
-                             mp <- (Just <$> checkConsumes readPatch') <|> return Nothing
-                             case mp of
-                               Just (Sealed p) -> do --tracePeek "found one patch"
-                                                     Sealed ps <- read_patches
-                                                     return $ Sealed (p:>:ps)
-                               Nothing -> return $ Sealed NilFL
---           tracePeek x = do y <- peekInput
---                            traceDoc (greenText x $$ greenText (show $ sal_to_string y)) return ()
-
-instance (ReadPatch p, PatchListFormat p) => ReadPatch (RL p) where
-    readPatch' = mapSeal reverseFL <$> readPatch'
-
-{-# INLINE bracketedFL #-}
-bracketedFL :: forall p wX .
-               (forall wY . Parser (Sealed (p wY))) -> Char -> Char -> Parser (Sealed (FL p wX))
-bracketedFL parser pre post =
-    peekforc pre bfl mzero
-        where bfl :: forall wZ . Parser (Sealed (FL p wZ))
-              bfl = peekforc post (return $ Sealed NilFL)
-                                  (do Sealed p <- parser
-                                      Sealed ps <- bfl
-                                      return $ Sealed (p:>:ps))
-
-{-# INLINE peekforc #-}
-peekforc :: Char -> Parser a -> Parser a -> Parser a
-peekforc c ifstr ifnot = choice [ lexChar c >> ifstr
-                                , ifnot ]
-
-peekfor :: BC.ByteString -> Parser a -> Parser a -> Parser a
-peekfor ps ifstr ifnot = choice [ do lexString ps
-                                     ifstr
-                                , ifnot ]
-{-# INLINE peekfor #-}
+-- | This instance is needed to parse patch bundles
+instance ReadPatch p => ReadPatches (Bracketed p)
 
--- See also Darcs.Patch.Show.formatFileName.
-readFileName :: HasCallStack => FileNameFormat -> Parser AnchoredPath
-readFileName fmt = do
-  raw <- lexWord
-  case BC.stripPrefix (BC.pack "./") raw of
-    Nothing -> fail $ "invalid file path"
-    Just raw' ->
-      case convert fmt raw' of
-        Left e -> fail e
-        Right r -> return r
+-- | Given a 'Parser' for single patch, parse a (plain) sequence of such
+-- patches, nested between the given (required) start and end tokens.
+{-# INLINE readBracketedFL #-}
+readBracketedFL
+  :: forall p wX
+   . (forall wY . Parser (Sealed (p wY)))
+  -> Char
+  -> Char
+  -> Parser (Sealed (FL p wX))
+readBracketedFL single pre post = lexChar pre >> go
   where
-    convert FileNameFormatV1 =
-      floatPath <=< decodeWhite . decodeLocale . BC.pack . unpackPSFromUTF8
-    convert FileNameFormatV2 =
-      floatPath <=< decodeWhite . decodeLocale
-    convert FileNameFormatDisplay = error "readFileName called with FileNameFormatDisplay"
+    go :: forall wZ. Parser (Sealed (FL p wZ))
+    go = none <|> some
+    none = lexChar post >> pure (Sealed NilFL)
+    some = do
+      Sealed p <- single
+      Sealed ps <- go
+      return $ Sealed (p :>: ps)
diff --git a/src/Darcs/Patch/Rebase/Change.hs b/src/Darcs/Patch/Rebase/Change.hs
index e96eab2d..b628099a 100644
--- a/src/Darcs/Patch/Rebase/Change.hs
+++ b/src/Darcs/Patch/Rebase/Change.hs
@@ -1,10 +1,13 @@
 --  Copyright (C) 2009 Ganesh Sittampalam
 --
 --  BSD3
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
 module Darcs.Patch.Rebase.Change
     ( RebaseChange(..)
     , extractRebaseChange
     , reifyRebaseChange
+    , forceCommuteRebaseChange
     , partitionUnconflicted
     , rcToPia
     , WithDroppedDeps(..)
@@ -24,10 +27,9 @@ import Darcs.Patch.CommuteFn
     )
 import Darcs.Patch.Debug ( PatchDebug(..) )
 import Darcs.Patch.Effect ( Effect(..) )
-import Darcs.Patch.FileHunk ( IsHunk(..) )
-import Darcs.Patch.Format ( PatchListFormat(..) )
+import Darcs.Patch.Format ( FormatPatch(..), formatPatchFL )
 import Darcs.Patch.Ident ( Ident(..), PatchId )
-import Darcs.Patch.Info ( PatchInfo, patchinfo, displayPatchInfo )
+import Darcs.Patch.Info ( PatchInfo, patchinfo, showPatchInfo )
 import Darcs.Patch.Invert ( invert )
 import Darcs.Patch.Merge ( selfMerger )
 import Darcs.Patch.Named
@@ -45,7 +47,7 @@ import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, n2pia )
 import Darcs.Patch.Apply ( Apply(..) )
 import Darcs.Patch.Commute ( Commute(..) )
 import Darcs.Patch.Inspect ( PatchInspect(..) )
-import Darcs.Patch.Read ( ReadPatch(..) )
+import Darcs.Patch.Read ( ReadPatch(..), ReadPatches(..) )
 import Darcs.Patch.Show ( ShowPatch(..) )
 import Darcs.Patch.Summary
     ( ConflictState(..)
@@ -71,7 +73,7 @@ import Darcs.Patch.Rebase.PushFixup
   , pushFixupIdMB_FLIdFLFL
   )
 import Darcs.Patch.RepoPatch ( RepoPatch )
-import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatchFor(..), ShowContextPatch(..) )
+import Darcs.Patch.Show ( ShowPatchBasic(..), ShowContextPatch(..) )
 import Darcs.Patch.Unwind ( Unwound(..), fullUnwind )
 import Darcs.Patch.V3 ( RepoPatchV3 )
 import Darcs.Patch.Witnesses.Maybe ( Maybe2(..) )
@@ -81,9 +83,10 @@ import Darcs.Patch.Witnesses.Sealed
 import Darcs.Patch.Witnesses.Show ( Show1, Show2 )
 import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
 import qualified Darcs.Util.Diff as D ( DiffAlgorithm )
+import qualified Darcs.Util.Format as F ( vcat, ascii )
 import Darcs.Util.IsoDate ( getIsoDateTime )
 import Darcs.Util.Parser ( lexString )
-import Darcs.Util.Printer ( Doc, ($$), (<+>), blueText )
+import Darcs.Util.Printer ( Doc, ($$) )
 
 import qualified Data.ByteString.Char8 as BC ( pack )
 import Data.List ( (\\) )
@@ -144,13 +147,18 @@ instance Commute prim => Summary (RebaseChange prim) where
           unconflicted :> _ :> conflicted ->
             mapFL (IsC Okay) unconflicted ++ mapFL (IsC Conflicted) conflicted
 
+instance PrimPatch prim => FormatPatch (RebaseChange prim) where
+  formatPatch (RC fixups toedit) =
+    F.vcat
+      [ F.ascii "rebase-change ("
+      , formatPatchFL fixups
+      , F.ascii ")"
+      , formatPatch toedit
+      ]
+
 instance PrimPatch prim => ShowPatchBasic (RebaseChange prim) where
-  showPatch ForStorage (RC fixups toedit) =
-    blueText "rebase-change"
-      <+> blueText "(" $$ showPatch ForStorage fixups $$ blueText ")"
-      $$ showPatch ForStorage toedit
-  showPatch ForDisplay rc@(RC _ (NamedP n _ _)) =
-    displayPatchInfo n $$ rebaseChangeContent rc
+  showPatch rc@(RC _ (NamedP n _ _)) =
+    showPatchInfo n $$ rebaseChangeContent rc
 
 rebaseChangeContent
   :: forall prim wX wY . PrimPatch prim => RebaseChange prim wX wY -> Doc
@@ -176,7 +184,7 @@ instance PrimPatch prim => ShowPatch (RebaseChange prim) where
     -- but that introduces a spurious dependency on Summary (PrimOf p),
     -- because of other methods in the Named instance, so we just inline
     -- the implementation from Named here.
-    description (RC _ (NamedP n _ _)) = displayPatchInfo n
+    description (RC _ (NamedP n _ _)) = showPatchInfo n
     -- TODO report conflict indicating name fixups (i.e. dropped deps)
     summary p@(RC fs (NamedP _ ds _)) =
       showDependencies ShowDroppedDeps ShowDepsSummary (droppedDeps fs) $$
@@ -194,13 +202,13 @@ instance PrimPatch prim => ShowPatch (RebaseChange prim) where
 
 -- TODO this is a dummy instance that does not actually show context
 instance PrimPatch prim => ShowContextPatch (RebaseChange prim) where
-    showPatchWithContextAndApply f p = apply p >> return (showPatch f p)
+    showPatchWithContextAndApply p = apply p >> return (showPatch p)
 
-instance (ReadPatch prim, PatchListFormat prim) => ReadPatch (RebaseChange prim) where
+instance ReadPatches prim => ReadPatch (RebaseChange prim) where
   readPatch' = do
     lexString (BC.pack "rebase-change")
     lexString (BC.pack "(")
-    Sealed fixups <- readPatch'
+    Sealed fixups <- readPatchFL'
     lexString (BC.pack ")")
     Sealed contents <- readPatch'
     return $ Sealed $ RC fixups contents
@@ -357,7 +365,7 @@ forceCommuteName (AddName an :> WithDroppedDeps (NamedP pn deps body) ddeps)
       :>
       AddName an
 forceCommuteName (DelName dn :> p@(WithDroppedDeps (NamedP pn deps _body) _ddeps))
-  | dn == pn = error "impossible case"
+  | dn == pn = unsafeCoerceP p :> DelName dn
   | dn `elem` deps = error "impossible case"
   | otherwise = unsafeCoerceP p :> DelName dn
 forceCommuteName (Rename old new :> WithDroppedDeps (NamedP pn deps body) ddeps)
@@ -440,11 +448,60 @@ extractRebaseChange da rcs = go (NilFL :> rcs)
         -- finally force-commute the fixups with this and any other patches we are
         -- unsuspending.
         RC fixups toedit :> fixupsOut2 ->
-          case forceCommutes (fixups :> WithDroppedDeps (fromPrimNamed toedit) []) of
+          case forceCommutes (fixups :> noDroppedDeps (fromPrimNamed toedit)) of
             toedit' :> fixupsOut1 ->
               case go (fixupsOut1 +>+ fixupsOut2 :> rest) of
                 toedits' :> fixupsOut -> toedit' :>: toedits' :> fixupsOut
 
+-- TODO this is slightly incorrect in that we create RebaseChange patches
+-- with fixups that aren't fully pushed through.
+forceCommuteRebaseChange
+  :: forall prim wX wY
+   . PrimPatch prim
+  => (RebaseChange prim :> RebaseChange prim) wX wY
+  -> Maybe ((RebaseChange prim :> RebaseChange prim) wX wY)
+forceCommuteRebaseChange (RC fs1 e1 :> RC fs2 e2@(NamedP n2 ds2 _)) = do
+  fs2' :> NamedP n1 ds1 ps1' <- commuterIdFL commuteNamedFixup (e1 :> fs2)
+  (np2' :: Named (RepoPatchV3 prim) _ _) :> ps1'' <-
+    return $ simpleForceCommutePrims (ps1' :> fromPrimNamed e2)
+  Unwound fs2'' ps2' fs2''' <- return $ fullUnwind np2'
+  let nameFixups2 =
+        if n1 `elem` ds2 then NameFixup (AddName n1) :>: NilFL else NilFL
+  let nameFixups1 =
+        if n1 `elem` ds2 then NameFixup (DelName n1) :>: NilFL else NilFL
+  return $
+    RC
+      (fs1 +>+ fs2' +>+ mapFL_FL PrimFixup fs2'' +>+ nameFixups2)
+      (NamedP n2 ds2 ps2')
+    :>
+    RC
+      (nameFixups1 +>+ mapFL_FL PrimFixup (reverseRL fs2'''))
+      (NamedP n1 ds1 ps1'')
+
+-- | Plural version of 'simpleForceCommutePrim'.
+simpleForceCommutePrims
+  :: RepoPatch p
+  => (FL (PrimOf p) :> Named p) wX wY
+  -> (Named p :> FL (PrimOf p)) wX wY
+simpleForceCommutePrims (NilFL :> nq) = nq :> NilFL
+simpleForceCommutePrims (p :>: ps :> nq) =
+  case simpleForceCommutePrims (ps :> nq) of
+    nq' :> ps' ->
+      case simpleForceCommutePrim (p :> nq') of
+        nq'' :> p' -> nq'' :> (p' +>+ ps')
+
+-- | Like 'forceCommutePrim' but without injecting an inverse pair into the
+-- resulting 'WDDNamed'. This is not needed here, since we immediately turn the
+-- 'WDDNamed' back into a 'RebaseChange' using 'fullUnwind'. Indeed, using
+-- 'forceCommutePrim' here makes 'fullUnwind' run into an "impossible" case.
+simpleForceCommutePrim
+  :: RepoPatch p
+  => (PrimOf p :> Named p) wX wY
+  -> (Named p :> FL (PrimOf p)) wX wY
+simpleForceCommutePrim (p :> wq) =
+  case mergerIdNamed selfMerger (fromAnonymousPrim (invert p) :\/: wq) of
+    wq' :/\: irp' -> wq' :> invert (effect irp')
+
 -- signature to be compatible with extractRebaseChange
 -- | Like 'extractRebaseChange', but any fixups are "reified" into a separate patch.
 reifyRebaseChange
@@ -484,13 +541,6 @@ mkDummy (AddName pi) = infopatch pi (unsafeCoerceP NilFL)
 mkDummy (DelName _) = error "internal error: can't make a dummy patch from a delete"
 mkDummy (Rename _ _) = error "internal error: can't make a dummy patch from a rename"
 
-instance IsHunk (RebaseChange prim) where
-    -- RebaseChange is a compound patch, so it doesn't really make sense to
-    -- ask whether it's a hunk. TODO: get rid of the need for this.
-    isHunk _ = Nothing
-
-instance PatchListFormat (RebaseChange prim)
-
 addNamedToRebase
   :: RepoPatch p
   => D.DiffAlgorithm
diff --git a/src/Darcs/Patch/Rebase/Fixup.hs b/src/Darcs/Patch/Rebase/Fixup.hs
index 56435f8f..d6f98273 100644
--- a/src/Darcs/Patch/Rebase/Fixup.hs
+++ b/src/Darcs/Patch/Rebase/Fixup.hs
@@ -8,6 +8,7 @@ module Darcs.Patch.Rebase.Fixup
     , commuteNamedFixup, commuteFixupNamed
     , pushFixupFixup
     , flToNamesPrims, namedToFixups
+    , primNamedToFixups
     ) where
 
 import Darcs.Prelude
@@ -16,13 +17,13 @@ import Darcs.Patch.Apply ( Apply(..) )
 import Darcs.Patch.Commute ( Commute(..), selfCommuter )
 import Darcs.Patch.CommuteFn ( totalCommuterIdFL )
 import Darcs.Patch.Effect ( Effect(..) )
+import Darcs.Patch.Format ( FormatPatch(..) )
 import Darcs.Patch.Inspect ( PatchInspect(..) )
 import Darcs.Patch.Invert ( Invert(..) )
 import Darcs.Patch.Named ( Named(..) )
-import Darcs.Patch.Format ( PatchListFormat )
 import Darcs.Patch.FromPrim ( PrimPatchBase(..) )
 import Darcs.Patch.Prim ( PrimPatch, canonizeFL )
-import Darcs.Patch.Read ( ReadPatch(..) )
+import Darcs.Patch.Read ( ReadPatch(..), ReadPatches(..) )
 import Darcs.Patch.Rebase.Name
     ( RebaseName(..)
     , commuteNamedName, commuteNameNamed
@@ -40,6 +41,7 @@ import Darcs.Patch.Witnesses.Sealed ( Sealed, mapSeal )
 import Darcs.Patch.Witnesses.Show ( Show1, Show2, showsPrec2, appPrec )
 
 import qualified Darcs.Util.Diff as D ( DiffAlgorithm )
+import qualified Darcs.Util.Format as F ( vcat, ascii )
 import Darcs.Util.Parser ( Parser, lexString )
 import Darcs.Util.Printer ( ($$), (<+>), blueText )
 
@@ -54,7 +56,12 @@ data RebaseFixup prim wX wY where
   NameFixup :: RebaseName wX wY -> RebaseFixup prim wX wY
 
 namedToFixups :: Effect p => Named p wX wY -> FL (RebaseFixup (PrimOf p)) wX wY
-namedToFixups (NamedP p _ contents) = NameFixup (AddName p) :>: mapFL_FL PrimFixup (effect contents)
+namedToFixups (NamedP p _ contents) =
+  NameFixup (AddName p) :>: mapFL_FL PrimFixup (effect contents)
+
+primNamedToFixups :: Named prim wX wY -> FL (RebaseFixup prim) wX wY
+primNamedToFixups (NamedP p _ contents) =
+  NameFixup (AddName p) :>: mapFL_FL PrimFixup contents
 
 instance Show2 prim => Show (RebaseFixup prim wX wY) where
     showsPrec d (PrimFixup p) =
@@ -87,16 +94,20 @@ instance PatchInspect prim => PatchInspect (RebaseFixup prim) where
     hunkMatches f (PrimFixup p) = hunkMatches f p
     hunkMatches f (NameFixup n) = hunkMatches f n
 
-instance PatchListFormat (RebaseFixup prim)
+instance FormatPatch prim => FormatPatch (RebaseFixup prim) where
+  formatPatch (PrimFixup p) =
+    F.vcat [F.ascii "rebase-fixup (", formatPatch p, F.ascii ")"]
+  formatPatch (NameFixup p) =
+    F.vcat [F.ascii "rebase-name (", formatPatch p, F.ascii ")"]
 
 instance ShowPatchBasic prim => ShowPatchBasic (RebaseFixup prim) where
-  showPatch f (PrimFixup p) =
-    blueText "rebase-fixup" <+> blueText "(" $$ showPatch f p $$ blueText ")"
-  showPatch f (NameFixup p) =
-    blueText "rebase-name" <+> blueText "(" $$ showPatch f p $$ blueText ")"
+  showPatch (PrimFixup p) =
+    blueText "rebase-fixup" <+> blueText "(" $$ showPatch p $$ blueText ")"
+  showPatch (NameFixup p) =
+    blueText "rebase-name" <+> blueText "(" $$ showPatch p $$ blueText ")"
 
 instance ReadPatch prim => ReadPatch (RebaseFixup prim) where
- readPatch' =
+  readPatch' =
    mapSeal PrimFixup <$> readWith (BC.pack "rebase-fixup" ) <|>
    mapSeal NameFixup <$> readWith (BC.pack "rebase-name"  )
    where
@@ -108,6 +119,7 @@ instance ReadPatch prim => ReadPatch (RebaseFixup prim) where
        lexString (BC.pack ")")
        return res
 
+instance ReadPatch prim => ReadPatches (RebaseFixup prim)
 
 instance Commute prim => Commute (RebaseFixup prim) where
     commute (PrimFixup p :> PrimFixup q) = do
diff --git a/src/Darcs/Patch/Rebase/Legacy/Item.hs b/src/Darcs/Patch/Rebase/Legacy/Item.hs
index 2f0b9d97..a3261003 100644
--- a/src/Darcs/Patch/Rebase/Legacy/Item.hs
+++ b/src/Darcs/Patch/Rebase/Legacy/Item.hs
@@ -6,10 +6,9 @@ module Darcs.Patch.Rebase.Legacy.Item
 
 import Darcs.Prelude
 
-import Darcs.Patch.Format ( PatchListFormat(..) )
 import Darcs.Patch.Named ( Named(..) )
-import Darcs.Patch.Read ( ReadPatch(..) )
-import Darcs.Patch.FromPrim ( PrimPatchBase, PrimOf )
+import Darcs.Patch.Read ( ReadPatch(..), ReadPatches(..) )
+import Darcs.Patch.FromPrim ( PrimOf )
 import Darcs.Patch.Rebase.Change ( RebaseChange(..), addNamedToRebase )
 import Darcs.Patch.Rebase.Fixup ( RebaseFixup(..) )
 import Darcs.Patch.RepoPatch ( RepoPatch )
@@ -65,7 +64,7 @@ toRebaseChanges (ToEdit te :>: ps) =
 -- This Read instance partly duplicates the instances for RebaseFixup,
 -- but are left this way given this code is now here only for backwards compatibility of the on-disk
 -- format and we might want to make future changes to RebaseFixup.
-instance (PrimPatchBase p, PatchListFormat p, ReadPatch p) => ReadPatch (RebaseItem p) where
+instance (ReadPatches p, ReadPatch (PrimOf p)) => ReadPatch (RebaseItem p) where
    readPatch' = mapSeal ToEdit              <$> readWith (BC.pack "rebase-toedit") <|>
                 mapSeal (Fixup . PrimFixup) <$> readWith (BC.pack "rebase-fixup" ) <|>
                 mapSeal (Fixup . NameFixup) <$> readWith (BC.pack "rebase-name"  )
@@ -75,3 +74,5 @@ instance (PrimPatchBase p, PatchListFormat p, ReadPatch p) => ReadPatch (RebaseI
                              res <- readPatch'
                              lexString (BC.pack ")")
                              return res
+
+instance (ReadPatches p, ReadPatch (PrimOf p)) => ReadPatches (RebaseItem p)
diff --git a/src/Darcs/Patch/Rebase/Legacy/Wrapped.hs b/src/Darcs/Patch/Rebase/Legacy/Wrapped.hs
index 14674b8d..4bd5102f 100644
--- a/src/Darcs/Patch/Rebase/Legacy/Wrapped.hs
+++ b/src/Darcs/Patch/Rebase/Legacy/Wrapped.hs
@@ -7,14 +7,12 @@ module Darcs.Patch.Rebase.Legacy.Wrapped
 import Darcs.Prelude
 
 import Control.Applicative ( (<|>) )
-import Data.Coerce ( coerce )
 
 import Darcs.Patch.Effect ( Effect(..) )
-import Darcs.Patch.Format ( PatchListFormat(..), ListFormat )
 import Darcs.Patch.Info ( PatchInfo )
 import Darcs.Patch.FromPrim ( FromPrim, PrimPatchBase(..) )
 import Darcs.Patch.Named ( Named(..) )
-import Darcs.Patch.Read ( ReadPatch(..) )
+import Darcs.Patch.Read ( ReadPatch(..), ReadPatches(..), legacyReadPatchFL' )
 import Darcs.Patch.Rebase.Suspended ( Suspended, readSuspended )
 import Darcs.Patch.RepoPatch ( RepoPatch )
 import Darcs.Patch.Witnesses.Sealed ( Sealed(..), mapSeal )
@@ -73,9 +71,9 @@ instance RepoPatch p => ReadPatch (WrappedNamed p) where
     unRead (ReadNormal p) = p
     unRead (ReadSuspended _) = error "unexpected suspended patch"
 
-instance PatchListFormat p => PatchListFormat (ReadRebasing p) where
-  patchListFormat = coerce (patchListFormat :: ListFormat p)
-
 instance RepoPatch p => ReadPatch (ReadRebasing p) where
   readPatch' =
     Sealed . ReadSuspended <$> readSuspended <|> mapSeal ReadNormal <$> readPatch'
+
+instance RepoPatch p => ReadPatches (ReadRebasing p) where
+  readPatchFL' = legacyReadPatchFL'
diff --git a/src/Darcs/Patch/Rebase/Name.hs b/src/Darcs/Patch/Rebase/Name.hs
index fab12058..d0519e38 100644
--- a/src/Darcs/Patch/Rebase/Name.hs
+++ b/src/Darcs/Patch/Rebase/Name.hs
@@ -14,7 +14,8 @@ import Darcs.Prelude
 
 import Darcs.Patch.Commute ( Commute(..) )
 import Darcs.Patch.CommuteFn ( CommuteFn, commuterIdFL, commuterFLId )
-import Darcs.Patch.Info ( PatchInfo, showPatchInfo, readPatchInfo )
+import Darcs.Patch.Format ( FormatPatch(..) )
+import Darcs.Patch.Info ( PatchInfo, formatPatchInfo, showPatchInfo, readPatchInfo )
 import Darcs.Patch.Inspect ( PatchInspect(..) )
 import Darcs.Patch.Invert ( Invert(..) )
 import Darcs.Patch.Named ( Named(..) )
@@ -29,6 +30,7 @@ import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePEnd )
 
 import Darcs.Patch.Rebase.PushFixup ( PushFixupFn )
 
+import qualified Darcs.Util.Format as F ( ascii, ($$) )
 import Darcs.Util.Parser ( lexString )
 import Darcs.Util.Printer ( empty, blueText, ($$) )
 
@@ -54,10 +56,16 @@ instance Show1 (RebaseName wX)
 
 instance Show2 RebaseName
 
+instance FormatPatch RebaseName where
+  formatPatch (AddName n) = F.ascii "addname" F.$$ formatPatchInfo n
+  formatPatch (DelName n) = F.ascii "delname" F.$$ formatPatchInfo n
+  formatPatch (Rename old new) =
+    F.ascii "rename" F.$$ formatPatchInfo old F.$$ formatPatchInfo new
+
 instance ShowPatchBasic RebaseName where
-   showPatch f (AddName n) = blueText "addname" $$ showPatchInfo f n
-   showPatch f (DelName n) = blueText "delname" $$ showPatchInfo f n
-   showPatch f (Rename old new) = blueText "rename" $$ showPatchInfo f old $$ showPatchInfo f new
+   showPatch (AddName n) = blueText "addname" $$ showPatchInfo n
+   showPatch (DelName n) = blueText "delname" $$ showPatchInfo n
+   showPatch (Rename old new) = blueText "rename" $$ showPatchInfo old $$ showPatchInfo new
 
 instance ShowPatch RebaseName where
    summary _ = empty -- TODO improve this?
diff --git a/src/Darcs/Patch/Rebase/Suspended.hs b/src/Darcs/Patch/Rebase/Suspended.hs
index 6352c214..5f98e9a7 100644
--- a/src/Darcs/Patch/Rebase/Suspended.hs
+++ b/src/Darcs/Patch/Rebase/Suspended.hs
@@ -4,6 +4,7 @@ module Darcs.Patch.Rebase.Suspended
     , countToEdit, simplifyPush, simplifyPushes
     , addFixupsToSuspended, removeFixupsFromSuspended
     , addToEditsToSuspended
+    , formatSuspended
     , readSuspended
     , showSuspended
     ) where
@@ -11,23 +12,25 @@ module Darcs.Patch.Rebase.Suspended
 import Darcs.Prelude
 
 import Darcs.Patch.Effect ( Effect(..) )
+import Darcs.Patch.Format ( formatPatchFL )
 import Darcs.Patch.Invert ( invert )
 import Darcs.Patch.Named ( Named(..) )
 import Darcs.Patch.Info ( replaceJunk )
 import Darcs.Patch.Read ( ReadPatch(..) )
 import Darcs.Patch.FromPrim ( PrimPatchBase(..) )
-import Darcs.Patch.Read ( bracketedFL )
+import Darcs.Patch.Read ( readBracketedFL )
 import Darcs.Patch.Rebase.Fixup ( RebaseFixup(..), namedToFixups )
 import Darcs.Patch.Rebase.Name ( RebaseName(..) )
 import Darcs.Patch.RepoPatch ( RepoPatch )
 import qualified Darcs.Patch.Rebase.Change as Change ( simplifyPush, simplifyPushes )
 import Darcs.Patch.Rebase.Change ( RebaseChange(..), addNamedToRebase )
 import Darcs.Patch.Rebase.Legacy.Item as Item ( toRebaseChanges )
-import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatchFor )
+import Darcs.Patch.Show ( ShowPatchBasic(..) )
 import Darcs.Util.Parser ( Parser, lexString, lexWord )
 import Darcs.Patch.Witnesses.Ordered
 import Darcs.Patch.Witnesses.Sealed
 import Darcs.Patch.Witnesses.Show ( Show2 )
+import qualified Darcs.Util.Format as F ( Format, ascii, vcat )
 import Darcs.Util.Printer ( Doc, vcat, text, blueText, ($$), (<+>) )
 import qualified Darcs.Util.Diff as D ( DiffAlgorithm(MyersDiff) )
 
@@ -42,11 +45,14 @@ data Suspended p wX where
 
 deriving instance (Show2 p, Show2 (PrimOf p)) => Show (Suspended p wX)
 
-showSuspended :: PrimPatchBase p
-              => ShowPatchFor -> Suspended p wX -> Doc
-showSuspended f (Items ps)
+formatSuspended :: PrimPatchBase p => Suspended p wX -> F.Format
+formatSuspended (Items ps) =
+  F.vcat [F.ascii "rebase 0.2 {", formatPatchFL ps, F.ascii "}"]
+
+showSuspended :: PrimPatchBase p => Suspended p wX -> Doc
+showSuspended (Items ps)
        = blueText "rebase" <+> text "0.2" <+> blueText "{"
-         $$ vcat (mapFL (showPatch f) ps)
+         $$ vcat (mapFL showPatch ps)
          $$ blueText "}"
 
 readSuspended :: forall p wX. RepoPatch p => Parser (Suspended p wX)
@@ -57,7 +63,7 @@ readSuspended =
          _ | version == BC.pack "0.2" ->
               (lexString (BC.pack "{}") >> return (Items NilFL))
               <|>
-              (unseal Items <$> bracketedFL readPatch' '{' '}')
+              (unseal Items <$> readBracketedFL readPatch' '{' '}')
            -- version 0.1 was a very temporary intermediate state on the way to 0.2
            -- and we don't offer an upgrade path for it.
            | version == BC.pack "0.0" ->
@@ -74,7 +80,7 @@ readSuspended =
                (lexString (BC.pack "{}") >> return (Items NilFL))
                <|>
                (unseal Items . unseal (Item.toRebaseChanges @p) <$>
-                bracketedFL readPatch' '{' '}')
+                readBracketedFL readPatch' '{' '}')
            | otherwise -> error $ "can't handle rebase version " ++ show version
 
 countToEdit :: Suspended p wX -> Int
diff --git a/src/Darcs/Patch/RepoPatch.hs b/src/Darcs/Patch/RepoPatch.hs
index 6c186162..ffad1410 100644
--- a/src/Darcs/Patch/RepoPatch.hs
+++ b/src/Darcs/Patch/RepoPatch.hs
@@ -11,13 +11,14 @@ module Darcs.Patch.RepoPatch
     , IsHunk(..)
     , Merge(..)
     , PatchInspect(..)
-    , PatchListFormat(..)
     , PrimPatchBase(..)
     , ReadPatch(..)
+    , ReadPatches(..)
     , RepairToFL(..)
     , ShowContextPatch(..)
     , ShowPatch(..)
     , ShowPatchBasic(..)
+    , FormatPatch(..)
     , Summary(..)
     , ToPrim(..)
     , Unwind(..)
@@ -31,11 +32,11 @@ import Darcs.Patch.Commute ( Commute(..) )
 import Darcs.Patch.Conflict ( Conflict(..) )
 import Darcs.Patch.Effect ( Effect(..) )
 import Darcs.Patch.FileHunk ( IsHunk(..) )
-import Darcs.Patch.Format ( PatchListFormat(..) )
+import Darcs.Patch.Format ( FormatPatch(..) )
 import Darcs.Patch.FromPrim ( PrimPatchBase(..), PrimOf, FromPrim(..), ToPrim(..) )
 import Darcs.Patch.Inspect ( PatchInspect(..) )
 import Darcs.Patch.Merge ( Merge(..) )
-import Darcs.Patch.Read ( ReadPatch(..) )
+import Darcs.Patch.Read ( ReadPatch(..), ReadPatches(..) )
 import Darcs.Patch.Repair ( RepairToFL(..), Check(..) )
 import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatch(..), ShowContextPatch(..) )
 import Darcs.Patch.Summary ( Summary(..) )
@@ -56,12 +57,12 @@ type RepoPatch p =
     , IsHunk (PrimOf p)
     , Merge p
     , PatchInspect p
-    , PatchListFormat p
     , PrimPatchBase p
-    , ReadPatch p
+    , ReadPatches p
     , RepairToFL p
     , ShowContextPatch p
     , ShowPatch p
+    , FormatPatch p
     , Summary p
     , ToPrim p
     , Unwind p
diff --git a/src/Darcs/Patch/Set.hs b/src/Darcs/Patch/Set.hs
index 39249cf6..e4c24236 100644
--- a/src/Darcs/Patch/Set.hs
+++ b/src/Darcs/Patch/Set.hs
@@ -32,6 +32,7 @@ module Darcs.Patch.Set
     , patchSetSplit
     , patchSetDrop
     , tagsCovering
+    , unwrapOneTagged
     ) where
 
 import Darcs.Prelude
@@ -200,3 +201,10 @@ patchSetDrop n (PatchSet (ts :<: Tagged ps t _) NilRL) =
   patchSetDrop n $ PatchSet ts (ps :<: t)
 patchSetDrop _ (PatchSet NilRL NilRL) = Sealed $ PatchSet NilRL NilRL
 patchSetDrop n (PatchSet ts (ps :<: _)) = patchSetDrop (n - 1) $ PatchSet ts ps
+
+-- |'unwrapOneTagged' unfolds a single Tagged object in a PatchSet, adding the
+-- tag and patches to the PatchSet's patch list.
+unwrapOneTagged :: PatchSet p wX wY -> Maybe (PatchSet p wX wY)
+unwrapOneTagged (PatchSet (ts :<: Tagged tps t _) ps) =
+    Just $ PatchSet ts (tps :<: t +<+ ps)
+unwrapOneTagged _ = Nothing
diff --git a/src/Darcs/Patch/Show.hs b/src/Darcs/Patch/Show.hs
index 1e12f506..ba1a2bf6 100644
--- a/src/Darcs/Patch/Show.hs
+++ b/src/Darcs/Patch/Show.hs
@@ -17,42 +17,32 @@
 
 module Darcs.Patch.Show
      ( ShowPatchBasic(..)
-     , displayPatch
-     , ShowPatchFor(..)
      , ShowPatch(..)
      , ShowContextPatch(..)
      , showPatchWithContext
-     , formatFileName
      ) where
 
 import Darcs.Prelude
 
 import Darcs.Patch.Apply ( ApplyState )
 import Darcs.Patch.ApplyMonad ( ApplyMonad, ApplyMonadTrans, evalApplyMonad )
-import Darcs.Patch.Object ( formatFileName )
 import Darcs.Patch.Witnesses.Ordered ( FL, mapFL )
 
 import Darcs.Util.English ( plural, Noun(Noun) )
 import Darcs.Util.Printer ( Doc, vcat )
 
-data ShowPatchFor = ForDisplay | ForStorage
-
-displayPatch :: ShowPatchBasic p => p wX wY -> Doc
-displayPatch p = showPatch ForDisplay p
-
 class ShowPatchBasic p where
-    showPatch :: ShowPatchFor -> p wX wY -> Doc
+    showPatch :: p wX wY -> Doc
 
 -- | Like 'showPatchWithContextAndApply' but without applying the patch
 -- in the monad @m@.
 showPatchWithContext
     :: (ApplyMonadTrans (ApplyState p) m, ShowContextPatch p)
-    => ShowPatchFor
-    -> ApplyState p m
+    => ApplyState p m
     -> p wX wY
     -> m Doc
-showPatchWithContext f st p =
-    evalApplyMonad (showPatchWithContextAndApply f p) st
+showPatchWithContext st p =
+    evalApplyMonad (showPatchWithContextAndApply p) st
 
 class ShowPatchBasic p => ShowContextPatch p where
     -- | Show a patch with context lines added, as diff -u does. Thus, it
@@ -67,12 +57,12 @@ class ShowPatchBasic p => ShowContextPatch p where
     -- For a version that does not apply the patch see 'showPatchWithContext'.
     showPatchWithContextAndApply
         :: (ApplyMonad (ApplyState p) m)
-        => ShowPatchFor -> p wX wY -> m Doc
+        => p wX wY -> m Doc
 
 -- | This class is used only for user interaction, not for storage. The default
 -- implementations for 'description' and 'content' are suitable only for
 -- 'PrimPatch' and 'RepoPatch' types. Logically, 'description' should default
--- to 'mempty' while 'content' should default to 'displayPatch'. We define them
+-- to 'mempty' while 'content' should default to 'showPatch'. We define them
 -- the other way around so that 'Darcs.UI.PrintPatch.showFriendly' gives
 -- reasonable results for all patch types.
 class ShowPatchBasic p => ShowPatch p where
@@ -80,7 +70,7 @@ class ShowPatchBasic p => ShowPatch p where
     content = mempty
 
     description :: p wX wY -> Doc
-    description = displayPatch
+    description = showPatch
 
     summary :: p wX wY -> Doc
 
diff --git a/src/Darcs/Patch/Split.hs b/src/Darcs/Patch/Split.hs
index fb3544de..9a717218 100644
--- a/src/Darcs/Patch/Split.hs
+++ b/src/Darcs/Patch/Split.hs
@@ -42,10 +42,10 @@ import Darcs.Patch.FileHunk ( FileHunk(..), IsHunk(..) )
 import Darcs.Patch.Read ( ReadPatch(..) )
 import Darcs.Patch.Show ( showPatch, ShowPatch(..) )
 import Darcs.Patch.Invert( Invert(..), invertFL )
-import Darcs.Patch.Prim ( PrimPatch, canonizeFL, primFromHunk )
+import Darcs.Patch.Prim ( canonizeFL )
+import Darcs.Patch.Prim.Class ( PrimCoalesce )
 import Darcs.Util.Parser ( parse )
 import Darcs.Patch.Read ()
-import Darcs.Patch.Show ( ShowPatchFor(ForDisplay) )
 import Darcs.Patch.Viewing ()
 
 import Darcs.Util.Printer ( renderPS )
@@ -54,6 +54,10 @@ import qualified Darcs.Util.Diff as D ( DiffAlgorithm )
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
 
+type PrimSplit prim =
+    ( IsHunk prim
+    , PrimCoalesce prim
+    )
 
 -- |A splitter is something that can take a patch and (possibly) render it
 -- as text in some format of its own choosing.
@@ -104,7 +108,7 @@ withEditedHead p res = res :>: invert res :>: p :>: NilFL
 rawSplitter :: (ShowPatch p, ReadPatch p, Invert p) => Splitter p
 rawSplitter = Splitter
     { applySplitter = \p ->
-        Just (renderPS . showPatch ForDisplay $ p
+        Just (renderPS . showPatch $ p
              ,\str -> case parse readPatch' str of
                         Right (Sealed res, _) -> Just (withEditedHead p res)
                         Left _                -> Nothing)
@@ -118,8 +122,11 @@ noSplitter :: Splitter p
 noSplitter = Splitter { applySplitter = const Nothing, canonizeSplit = id }
 
 
-doPrimSplit :: PrimPatch prim => D.DiffAlgorithm -> prim wX wY
-            -> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim wX wY))
+doPrimSplit
+  :: (IsHunk prim, PrimCoalesce prim)
+  => D.DiffAlgorithm
+  -> prim wX wY
+  -> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim wX wY))
 doPrimSplit da = doPrimSplit_ da True explanation
   where
     explanation =
@@ -134,13 +141,17 @@ doPrimSplit da = doPrimSplit_ da True explanation
         , ""
         ]
 
-doPrimSplit_ :: forall prim p wX wY. (PrimPatch prim, IsHunk p, ApplyState p ~ ApplyState prim)
-             => D.DiffAlgorithm
-             -> Bool
-             -> [B.ByteString]
-             -> p wX wY
-             -> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim wX wY))
-doPrimSplit_ da edit_before_part helptext (isHunk -> Just (FileHunk fn n before after))
+doPrimSplit_
+  :: forall prim wX wY
+   . ( IsHunk prim
+     , PrimCoalesce prim
+     )
+  => D.DiffAlgorithm
+  -> Bool
+  -> [B.ByteString]
+  -> prim wX wY
+  -> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim wX wY))
+doPrimSplit_ da edit_before_part helptext (isHunk -> Just (FileHunk xd fn n before after))
  = Just (B.concat $ intersperse (BC.pack "\n") $ concat
            [ helptext
            , [mkSep " BEFORE (reference) =========================="]
@@ -159,7 +170,7 @@ doPrimSplit_ da edit_before_part helptext (isHunk -> Just (FileHunk fn n before
                      else hunk before after' +>+ hunk after' after)
     where sep = BC.pack "=========================="
           hunk :: [B.ByteString] -> [B.ByteString] -> FL prim wA wB
-          hunk b a = canonizeFL da (primFromHunk (FileHunk fn n b a) :>: NilFL)
+          hunk b a = canonizeFL da (fromHunk (FileHunk xd fn n b a) :>: NilFL)
           mkSep s = BC.append sep (BC.pack s)
           breakSep xs = case break (sep `BC.isPrefixOf`) xs of
                            (_, []) -> Nothing
@@ -168,12 +179,16 @@ doPrimSplit_ _ _ _ _ = Nothing
 
 -- |Split a primitive hunk patch up by allowing the user to edit both the
 -- before and after lines, then insert fixup patches to clean up the mess.
-primSplitter :: PrimPatch p => D.DiffAlgorithm -> Splitter p
+primSplitter
+  :: (IsHunk p, PrimCoalesce p) => D.DiffAlgorithm -> Splitter p
 primSplitter da = Splitter { applySplitter = doPrimSplit da
                            , canonizeSplit = canonizeFL da }
 
-doReversePrimSplit :: PrimPatch prim => D.DiffAlgorithm -> prim wX wY
-                   -> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim wX wY))
+doReversePrimSplit
+  :: PrimSplit prim
+  => D.DiffAlgorithm
+  -> prim wX wY
+  -> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim wX wY))
 doReversePrimSplit da prim = do
   (text, parser) <- doPrimSplit_ da False reverseExplanation (invert prim)
   let parser' p = do
@@ -194,6 +209,7 @@ doReversePrimSplit da prim = do
         , ""
         ]
 
-reversePrimSplitter :: PrimPatch prim => D.DiffAlgorithm -> Splitter prim
+reversePrimSplitter
+  :: PrimSplit prim => D.DiffAlgorithm -> Splitter prim
 reversePrimSplitter da = Splitter { applySplitter = doReversePrimSplit da
                                   , canonizeSplit = canonizeFL da }
diff --git a/src/Darcs/Patch/Summary.hs b/src/Darcs/Patch/Summary.hs
index 15ba0a96..5c1b38d8 100644
--- a/src/Darcs/Patch/Summary.hs
+++ b/src/Darcs/Patch/Summary.hs
@@ -16,23 +16,19 @@ import Data.List.Ordered ( nubSort )
 import Data.Maybe ( catMaybes )
 import qualified Text.XML.Light as XML
 
-import Darcs.Patch.Format ( FileNameFormat(FileNameFormatDisplay) )
 import Darcs.Patch.FromPrim ( PrimPatchBase(..) )
 import Darcs.Patch.Inspect ( PatchInspect(..) )
 import Darcs.Patch.Prim ( PrimDetails(..) )
-import Darcs.Patch.Show ( formatFileName )
 import Darcs.Patch.SummaryData ( SummDetail(..), SummOp(..) )
 import Darcs.Patch.Witnesses.Ordered ( FL, mapFL )
 import Darcs.Patch.Witnesses.Show
 
-import Darcs.Util.Path ( AnchoredPath, anchorPath )
+import Darcs.Util.Path ( AnchoredPath, displayPath, realPath )
 import Darcs.Util.Printer
     ( Doc
     , ($$)
     , (<+>)
     , empty
-    , minus
-    , plus
     , text
     , vcat
     )
@@ -136,7 +132,7 @@ summChunkToXML (SummChunk detail c) =
       XML.unode t (XML.Attr (XML.unqual "conflict") "true":as, cs)
     xconf Duplicated t as cs =
       XML.unode t (XML.Attr (XML.unqual "suplicate") "true":as, cs)
-    xfn = anchorPath ""
+    xfn = realPath
     cdata s = XML.Text (XML.blank_cdata {XML.cdData = s})
     xad 0 = []
     xad a = [XML.Elem $ XML.unode "added_lines" (XML.Attr (XML.unqual "num") (show a))]
@@ -148,18 +144,22 @@ summChunkToXML (SummChunk detail c) =
 summChunkToLine :: Bool -> SummChunk -> Doc
 summChunkToLine machineReadable (SummChunk detail c) =
   case detail of
-   SummRmDir f   -> lconf c "R" $ formatFileName FileNameFormatDisplay f <> text "/"
-   SummAddDir f  -> lconf c "A" $ formatFileName FileNameFormatDisplay f <> text "/"
-   SummFile SummRm  f _ _ _ -> lconf c "R" $ formatFileName FileNameFormatDisplay f
-   SummFile SummAdd f _ _ _ -> lconf c "A" $ formatFileName FileNameFormatDisplay f
+   SummRmDir f   -> lconf c "R" $ fn f <> text "/"
+   SummAddDir f  -> lconf c "A" $ fn f <> text "/"
+   SummFile SummRm  f r a x
+     | machineReadable -> lconf c "R" $ fn f
+     | otherwise       -> lconf c "R" $ fn f <+> rm r <+> ad a <+> rp x
+   SummFile SummAdd f r a x
+     | machineReadable -> lconf c "A" $ fn f
+     | otherwise       -> lconf c "A" $ fn f <+> rm r <+> ad a <+> rp x
    SummFile SummMod f r a x
-     | machineReadable -> lconf c "M" $ formatFileName FileNameFormatDisplay f
-     | otherwise       -> lconf c "M" $ formatFileName FileNameFormatDisplay f <+> rm r <+> ad a <+> rp x
+     | machineReadable -> lconf c "M" $ fn f
+     | otherwise       -> lconf c "M" $ fn f <+> rm r <+> ad a <+> rp x
    SummMv f1 f2
-     | machineReadable -> text "F " <> formatFileName FileNameFormatDisplay f1
-                       $$ text "T " <> formatFileName FileNameFormatDisplay f2
-     | otherwise       -> text " "    <> formatFileName FileNameFormatDisplay f1
-                       <> text " -> " <> formatFileName FileNameFormatDisplay f2
+     | machineReadable -> text "F " <> fn f1
+                       $$ text "T " <> fn f2
+     | otherwise       -> text " "    <> fn f1
+                       <> text " -> " <> fn f2
    SummNone -> case c of
                Okay -> empty
                _    -> lconf c ""  empty
@@ -171,8 +171,9 @@ summChunkToLine machineReadable (SummChunk detail c) =
      | otherwise       = text t <+> x <+> text "duplicate"
    --
    ad 0 = empty
-   ad a = plus <> text (show a)
+   ad a = text "+" <> text (show a)
    rm 0 = empty
-   rm a = minus <> text (show a)
+   rm a = text "-" <> text (show a)
    rp 0 = empty
    rp a = text "r" <> text (show a)
+   fn = text . displayPath
diff --git a/src/Darcs/Patch/Unwind.hs b/src/Darcs/Patch/Unwind.hs
index b58a109e..75d5ca3a 100644
--- a/src/Darcs/Patch/Unwind.hs
+++ b/src/Darcs/Patch/Unwind.hs
@@ -14,7 +14,6 @@ import Darcs.Patch.Commute
 import Darcs.Patch.CommuteFn
   ( commuterIdFL, commuterFLId
   )
-import Darcs.Patch.Format ( PatchListFormat )
 import Darcs.Patch.FromPrim ( PrimOf )
 import Darcs.Patch.Invert
   ( Invert(..), invertFL, invertRL
@@ -56,16 +55,16 @@ deriving instance Show2 prim => Show (Unwound prim wX wY)
 instance Show2 prim => Show1 (Unwound prim wX)
 instance Show2 prim => Show2 (Unwound prim)
 
-instance (PatchListFormat prim, ShowPatchBasic prim)
+instance ShowPatchBasic prim
   => ShowPatchBasic (Unwound prim) where
-  showPatch f (Unwound before prims after) =
+  showPatch (Unwound before prims after) =
     vcat [
       blueText "before:",
-      showPatch f before,
+      showPatch before,
       blueText "prims:",
-      showPatch f prims,
+      showPatch prims,
       blueText "after:",
-      showPatch f after
+      showPatch after
     ]
 
 instance Invert prim => Invert (Unwound prim) where
diff --git a/src/Darcs/Patch/V1.hs b/src/Darcs/Patch/V1.hs
index 081e1fab..229d898d 100644
--- a/src/Darcs/Patch/V1.hs
+++ b/src/Darcs/Patch/V1.hs
@@ -3,6 +3,7 @@ module Darcs.Patch.V1 ( RepoPatchV1 ) where
 import Darcs.Patch.V1.Apply ()
 import Darcs.Patch.V1.Commute ()
 import Darcs.Patch.V1.Core ( RepoPatchV1 )
+import Darcs.Patch.V1.Format ()
 import Darcs.Patch.V1.Read ()
 import Darcs.Patch.V1.Show ()
 import Darcs.Patch.V1.Viewing ()
diff --git a/src/Darcs/Patch/V1/Commute.hs b/src/Darcs/Patch/V1/Commute.hs
index b5e415b4..364056fd 100644
--- a/src/Darcs/Patch/V1/Commute.hs
+++ b/src/Darcs/Patch/V1/Commute.hs
@@ -62,8 +62,9 @@ import Darcs.Patch.Permutations
     , nubFL
     )
 import Darcs.Util.Printer ( renderString, text, vcat, ($$) )
-import Darcs.Patch.V1.Show ( showPatch_ )
+import Darcs.Patch.V1.Show ()
 import Data.List.Ordered ( nubSort )
+import Darcs.Patch.Show ( ShowPatchBasic (..) )
 import Darcs.Patch.Summary
     ( Summary(..)
     , ConflictState(..)
@@ -312,7 +313,7 @@ reconcileUnwindings p (p1s:<:p1) p2s@(tp2s:<:p2) =
                 error $ renderString
                   $ text "in function reconcileUnwindings"
                   $$ text "Original patch:"
-                  $$ showPatch_ p
+                  $$ showPatch p
     _ -> error "in reconcileUnwindings"
 
 -- This code seems wrong, shouldn't the commute be invert p1 :> p2 ? And why isn't p1' re-inverted?
@@ -423,10 +424,12 @@ instance PrimPatch prim => Effect (RepoPatchV1 prim) where
     effect p@(Regrem{}) = invert $ effect $ invert p
     effect (PP p) = p :>: NilFL
 
-instance (PrimPatch prim, ApplyState prim ~ ApplyState (RepoPatchV1 prim)) =>
+instance (ApplyState prim ~ ApplyState (RepoPatchV1 prim), IsHunk prim) =>
          IsHunk (RepoPatchV1 prim) where
-    isHunk p = do PP p' <- return p
-                  isHunk p'
+    type ExtraData (RepoPatchV1 prim) = ExtraData prim
+    isHunk (PP p) = isHunk p
+    isHunk _ = Nothing
+    fromHunk = PP . fromHunk
 
 newUr :: PrimPatch prim
     => RepoPatchV1 prim wA wB -> RL (RepoPatchV1 prim) wX wY -> [Sealed (RL (RepoPatchV1 prim) wX)]
@@ -435,9 +438,9 @@ newUr p (ps :<: Merger _ _ p1 p2) =
    ((ps':<:_):_) -> newUr p (ps':<:unsafeCoercePStart p1) ++ newUr p (ps':<:unsafeCoercePStart p2)
    _ -> error $ renderString $ text "in function newUr"
                  $$ text "Original patch:"
-                 $$ showPatch_ p
+                 $$ showPatch p
                  $$ text "Unwound:"
-                 $$ vcat (unseal (mapRL showPatch_) $ unwind p)
+                 $$ vcat (unseal (mapRL showPatch) $ unwind p)
 
 newUr op ps =
     case filter (\(_:<:p) -> isMerger p) $ headPermutationsRL ps of
diff --git a/src/Darcs/Patch/V1/Core.hs b/src/Darcs/Patch/V1/Core.hs
index ca4eb653..a8b3e593 100644
--- a/src/Darcs/Patch/V1/Core.hs
+++ b/src/Darcs/Patch/V1/Core.hs
@@ -5,10 +5,6 @@ module Darcs.Patch.V1.Core
 
 import Darcs.Prelude
 
-import Darcs.Patch.Format
-    ( PatchListFormat(..)
-    , ListFormat(ListFormatV1)
-    )
 import Darcs.Patch.Debug ( PatchDebug(..) )
 import Darcs.Patch.FromPrim
     ( FromPrim(..)
@@ -89,13 +85,6 @@ mergerUndo :: RepoPatchV1 prim wX wY -> FL (RepoPatchV1 prim) wX wY
 mergerUndo (Merger undo _ _ _) = undo
 mergerUndo _ = error "impossible case"
 
-instance PatchListFormat (RepoPatchV1 prim) where
-   -- In principle we could use ListFormatDefault when prim /= V1 Prim patches,
-   -- as those are the only case where we need to support a legacy on-disk
-   -- format. In practice we don't expect Patch to be used with any other argument
-   -- anyway, so it doesn't matter.
-   patchListFormat = ListFormatV1
-
 instance Check (RepoPatchV1 prim)
    -- no checks
 
diff --git a/src/Darcs/Patch/V1/Format.hs b/src/Darcs/Patch/V1/Format.hs
new file mode 100644
index 00000000..1f7d0979
--- /dev/null
+++ b/src/Darcs/Patch/V1/Format.hs
@@ -0,0 +1,31 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Darcs.Patch.V1.Format () where
+
+import Darcs.Prelude
+
+import Darcs.Patch.Format ( FormatPatch(..) )
+import Darcs.Patch.V1.Core ( RepoPatchV1(..) )
+import Darcs.Patch.Witnesses.Ordered ( FL(..), mapFL )
+import Darcs.Util.Format ( Format, ascii, vcat, (<+>) )
+
+formatMerger
+  :: FormatPatch prim
+  => String
+  -> RepoPatchV1 prim wA wB
+  -> RepoPatchV1 prim wD wE
+  -> Format
+formatMerger merger_name p1 p2 =
+  vcat
+    [ ascii merger_name <+> ascii "0.0 ("
+    , formatPatch p1
+    , formatPatch p2
+    , ascii ")"
+    ]
+
+instance FormatPatch prim => FormatPatch (RepoPatchV1 prim) where
+  formatPatch (PP p            ) = formatPatch p
+  formatPatch (Merger _ _ p1 p2) = formatMerger "merger" p1 p2
+  formatPatch (Regrem _ _ p1 p2) = formatMerger "regrem" p1 p2
+  -- exceptional legacy encoding of patch lists
+  formatPatchFL (p :>: NilFL) = formatPatch p
+  formatPatchFL ps = vcat [ascii "{", vcat (mapFL formatPatch ps), ascii "}"]
diff --git a/src/Darcs/Patch/V1/Prim.hs b/src/Darcs/Patch/V1/Prim.hs
index 6735742a..939bf0c1 100644
--- a/src/Darcs/Patch/V1/Prim.hs
+++ b/src/Darcs/Patch/V1/Prim.hs
@@ -5,24 +5,22 @@ module Darcs.Patch.V1.Prim ( Prim(..) ) where
 
 import Darcs.Prelude
 
+import Control.Monad ( (<=<) )
+import qualified Data.ByteString.Char8 as BC ( pack, unpack )
 import Data.Coerce ( coerce )
 
 import Darcs.Patch.Annotate ( Annotate(..) )
 import Darcs.Patch.Apply ( Apply(..) )
 import Darcs.Patch.Commute ( Commute(..) )
 import Darcs.Patch.FileHunk ( IsHunk(..) )
-import Darcs.Patch.Format
-    ( PatchListFormat(..)
-    , ListFormat(ListFormatV1)
-    , FileNameFormat(FileNameFormatV1,FileNameFormatDisplay) )
+import Darcs.Patch.Format ( FormatPatch(..) )
 import Darcs.Patch.Inspect ( PatchInspect )
 import Darcs.Patch.Invert ( Invert )
 import Darcs.Patch.Merge ( CleanMerge )
-import Darcs.Patch.Read ( ReadPatch(..) )
+import Darcs.Patch.Read ( ReadPatch(..), ReadPatches(..), legacyReadPatchFL' )
 import Darcs.Patch.Repair ( RepairToFL(..) )
 import Darcs.Patch.Show
     ( ShowPatchBasic(..)
-    , ShowPatchFor(..)
     , ShowPatch(..)
     , ShowContextPatch(..)
     )
@@ -35,12 +33,15 @@ import Darcs.Patch.Witnesses.Sealed ( mapSeal )
 import Darcs.Patch.Prim.Class
     ( PrimConstruct(..), PrimCoalesce(..)
     , PrimDetails(..)
-    , PrimShow(..), PrimRead(..)
     , PrimApply(..)
     , PrimSift(..)
     , PrimMangleUnravelled(..)
     )
-import qualified Darcs.Patch.Prim.V1 as Base ( Prim )
+import qualified Darcs.Patch.Prim.V1 as Base ( Prim, formatPrim, readPrim )
+
+import Darcs.Util.ByteString ( decodeLocale, encodeLocale, unpackPSFromUTF8 )
+import Darcs.Util.Format ( stringUtf8 )
+import Darcs.Util.Path ( anchorPath, decodeWhite, encodeWhite, floatPath )
 
 newtype Prim x y = Prim { unPrim :: Base.Prim x y } deriving
     ( Annotate
@@ -58,6 +59,8 @@ newtype Prim x y = Prim { unPrim :: Base.Prim x y } deriving
     , PrimMangleUnravelled
     , PrimSift
     , Show
+    , ShowContextPatch
+    , ShowPatchBasic
     )
 
 instance Show1 (Prim wX)
@@ -65,25 +68,25 @@ instance Show1 (Prim wX)
 instance Show2 Prim
 
 instance ReadPatch Prim where
-  readPatch' = fmap (mapSeal Prim) (readPrim FileNameFormatV1)
-
-fileNameFormat :: ShowPatchFor -> FileNameFormat
-fileNameFormat ForDisplay = FileNameFormatDisplay
-fileNameFormat ForStorage = FileNameFormatV1
-
-instance ShowPatchBasic Prim where
-  showPatch fmt = showPrim (fileNameFormat fmt) . unPrim
+  readPatch' = fmap (mapSeal Prim) (Base.readPrim decodePath)
+    where
+      -- baroque legacy encoding
+      decodePath =
+        floatPath <=< decodeWhite . decodeLocale . BC.pack . unpackPSFromUTF8
 
-instance ShowContextPatch Prim where
-  showPatchWithContextAndApply fmt = showPrimWithContextAndApply (fileNameFormat fmt) . unPrim
+instance ReadPatches Prim where
+  readPatchFL' = legacyReadPatchFL'
 
 instance ShowPatch Prim where
   summary = plainSummaryPrim . unPrim
   summaryFL = plainSummaryPrims False
   thing _ = "change"
 
-instance PatchListFormat Prim where
-  patchListFormat = ListFormatV1
+instance FormatPatch Prim where
+  formatPatch = Base.formatPrim encodePath . unPrim
+    where
+      encodePath =
+        stringUtf8 . BC.unpack . encodeLocale . encodeWhite . anchorPath "."
 
 instance RepairToFL Prim where
   applyAndTryToFixFL = fmap coerce . applyAndTryToFixFL . unPrim
diff --git a/src/Darcs/Patch/V1/Read.hs b/src/Darcs/Patch/V1/Read.hs
index 3ec7a7a4..8e43e6cf 100644
--- a/src/Darcs/Patch/V1/Read.hs
+++ b/src/Darcs/Patch/V1/Read.hs
@@ -5,9 +5,8 @@ import Darcs.Prelude
 
 import Darcs.Patch.Invert ( invert )
 import Darcs.Patch.Prim ( PrimPatch )
-import Darcs.Patch.Read ( ReadPatch(..) )
-import Darcs.Util.Parser ( Parser, choice, string,
-                                lexChar, lexWord, skipSpace )
+import Darcs.Patch.Read ( ReadPatch(..), ReadPatches(..), legacyReadPatchFL' )
+import Darcs.Util.Parser ( Parser, choice, lexChar, lexWord, skipSpace, string )
 
 import Darcs.Patch.V1.Core ( RepoPatchV1(..) )
 import Darcs.Patch.V1.Commute ( merger )
@@ -21,11 +20,17 @@ import qualified Data.ByteString       as B  (ByteString )
 
 
 instance PrimPatch prim => ReadPatch (RepoPatchV1 prim) where
- readPatch'
-   = choice [ liftM seal $ skipSpace >> readMerger True
-            , liftM seal $ skipSpace >> readMerger False
-            , liftM (mapSeal PP) readPatch'
-            ]
+  readPatch' =
+    choice
+      [ liftM seal $ skipSpace >> readMerger True
+      , liftM seal $ skipSpace >> readMerger False
+      , liftM (mapSeal PP) readPatch'
+      ]
+
+instance PrimPatch prim => ReadPatches (RepoPatchV1 prim) where
+  readPatchFL' = legacyReadPatchFL'
+
+
 readMerger :: (PrimPatch prim) => Bool -> Parser (RepoPatchV1 prim wX wY)
 readMerger b = do string s
                   g <- lexWord
diff --git a/src/Darcs/Patch/V1/Show.hs b/src/Darcs/Patch/V1/Show.hs
index 843c2f61..670c0122 100644
--- a/src/Darcs/Patch/V1/Show.hs
+++ b/src/Darcs/Patch/V1/Show.hs
@@ -1,30 +1,26 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
-module Darcs.Patch.V1.Show ( showPatch_ ) where
+module Darcs.Patch.V1.Show () where
 
 import Darcs.Prelude
 
-import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatchFor(..) )
+import Darcs.Patch.Show ( ShowPatchBasic(..) )
 import Darcs.Patch.V1.Core ( RepoPatchV1(..) )
 
 import Darcs.Util.Printer ( Doc, text, blueText, ($$), (<+>) )
 
 
-showPatch_ :: ShowPatchBasic prim => prim wX wY -> Doc
-showPatch_ = showPatch ForDisplay
-
 showMerger :: ShowPatchBasic prim
-           => ShowPatchFor
-           -> String
+           => String
            -> RepoPatchV1 prim wA wB
            -> RepoPatchV1 prim wD wE
            -> Doc
-showMerger f merger_name p1 p2 =
+showMerger merger_name p1 p2 =
     blueText merger_name <+> text "0.0" <+> blueText "("
-                           $$ showPatch f p1
-                           $$ showPatch f p2
+                           $$ showPatch p1
+                           $$ showPatch p2
                            $$ blueText ")"
 
 instance ShowPatchBasic prim => ShowPatchBasic (RepoPatchV1 prim) where
-    showPatch f (PP p) = showPatch f p
-    showPatch f (Merger _ _ p1 p2) = showMerger f "merger" p1 p2
-    showPatch f (Regrem _ _ p1 p2) = showMerger f "regrem" p1 p2
+    showPatch (PP p) = showPatch p
+    showPatch (Merger _ _ p1 p2) = showMerger "merger" p1 p2
+    showPatch (Regrem _ _ p1 p2) = showMerger "regrem" p1 p2
diff --git a/src/Darcs/Patch/V1/Viewing.hs b/src/Darcs/Patch/V1/Viewing.hs
index 0500847c..f5c7d150 100644
--- a/src/Darcs/Patch/V1/Viewing.hs
+++ b/src/Darcs/Patch/V1/Viewing.hs
@@ -13,8 +13,8 @@ import Darcs.Patch.V1.Core ( RepoPatchV1(..) )
 import Darcs.Patch.V1.Show ()
 
 instance PrimPatch prim => ShowContextPatch (RepoPatchV1 prim) where
-    showPatchWithContextAndApply f (PP p) = showPatchWithContextAndApply f p
-    showPatchWithContextAndApply f p = apply p >> return (showPatch f p)
+    showPatchWithContextAndApply (PP p) = showPatchWithContextAndApply p
+    showPatchWithContextAndApply p = apply p >> return (showPatch p)
 
 instance PrimPatch prim => ShowPatch (RepoPatchV1 prim) where
     summary = plainSummary
diff --git a/src/Darcs/Patch/V2/Non.hs b/src/Darcs/Patch/V2/Non.hs
index 39e8113d..3a17300e 100644
--- a/src/Darcs/Patch/V2/Non.hs
+++ b/src/Darcs/Patch/V2/Non.hs
@@ -26,6 +26,8 @@ module Darcs.Patch.V2.Non
     , unNon
     , showNon
     , showNons
+    , formatNon
+    , formatNons
     , readNon
     , readNons
     , commutePrimsOrAddToCtx
@@ -43,11 +45,11 @@ module Darcs.Patch.V2.Non
 import Darcs.Prelude hiding ( (*>) )
 
 import Data.List ( delete )
-import Control.Monad ( liftM, mzero )
+import Control.Applicative ( (<|>) )
 import Darcs.Patch.Apply ( Apply(..) )
 import Darcs.Patch.Commute ( commuteFL )
 import Darcs.Patch.Effect ( Effect(..) )
-import Darcs.Patch.Format ( PatchListFormat )
+import Darcs.Patch.Format ( FormatPatch(..) )
 import Darcs.Patch.Invert ( Invert, invertFL, invertRL )
 import Darcs.Patch.FromPrim
     ( FromPrim(..), ToFromPrim
@@ -56,21 +58,21 @@ import Darcs.Patch.FromPrim
 import Darcs.Patch.Prim ( sortCoalesceFL )
 import Darcs.Patch.Commute ( Commute(..) )
 import Darcs.Patch.Invert ( Invert(invert) )
-import Darcs.Patch.Read ( ReadPatch(..) )
+import Darcs.Patch.Read ( ReadPatch(..), ReadPatches(..) )
 import Darcs.Patch.Show ( showPatch )
-import Darcs.Util.Parser ( Parser, lexChar )
+import Darcs.Util.Parser ( Parser, lexChar, lexString )
 import Darcs.Patch.Witnesses.Eq ( Eq2(..), EqCheck(..) )
 import Darcs.Patch.Witnesses.Ordered
     ( FL(..), RL(..), (+>+), mapRL_RL
     , (:>)(..), reverseFL, reverseRL )
 import Darcs.Patch.Witnesses.Show ( Show1, Show2, appPrec, showsPrec2 )
 import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed) )
-import Darcs.Patch.Read ( peekfor )
-import Darcs.Patch.Show ( ShowPatchBasic, ShowPatchFor )
+import Darcs.Patch.Show ( ShowPatchBasic )
 import Darcs.Patch.Viewing ()
 import Darcs.Patch.Permutations ( (=\~/=), removeFL, commuteWhatWeCanFL )
+import qualified Darcs.Util.Format as F
 import Darcs.Util.Printer ( Doc, empty, vcat, hiddenPrefix, blueText, ($$) )
-import qualified Data.ByteString.Char8 as BC ( pack, singleton )
+import qualified Data.ByteString.Char8 as BC ( pack )
 
 -- |A 'Non' stores a context with a 'Prim' patch. It is a patch whose effect
 -- isn't visible - a Non-affecting patch.
@@ -90,37 +92,41 @@ instance (Show2 p, Show2 (PrimOf p)) => Show (Non p wX) where
 instance (Show2 p, Show2 (PrimOf p)) => Show1 (Non p)
 
 -- |showNons creates a Doc representing a list of Nons.
-showNons :: (ShowPatchBasic p, PatchListFormat p, PrimPatchBase p)
-         => ShowPatchFor -> [Non p wX] -> Doc
-showNons _ [] = empty
-showNons f xs = blueText "{{" $$ vcat (map (showNon f) xs) $$ blueText "}}"
+showNons :: (ShowPatchBasic p, PrimPatchBase p)
+         => [Non p wX] -> Doc
+showNons [] = empty
+showNons xs = blueText "{{" $$ vcat (map showNon xs) $$ blueText "}}"
 
 -- |showNon creates a Doc representing a Non.
-showNon :: (ShowPatchBasic p, PatchListFormat p, PrimPatchBase p)
-        => ShowPatchFor
-        -> Non p wX
+showNon :: (ShowPatchBasic p, PrimPatchBase p)
+        => Non p wX
         -> Doc
-showNon f (Non c p) = hiddenPrefix "|" (showPatch f c)
+showNon (Non c p) = hiddenPrefix "|" (showPatch c)
                       $$ hiddenPrefix "|" (blueText ":")
-                      $$ showPatch f p
+                      $$ showPatch p
+
+formatNons :: (FormatPatch p, FormatPatch (PrimOf p)) => [Non p wX] -> F.Format
+formatNons [] = mempty
+formatNons xs = F.ascii "{{" F.$$ F.vcat (map formatNon xs) F.$$ F.ascii "}}"
+
+formatNon :: (FormatPatch p, FormatPatch (PrimOf p)) => Non p wX -> F.Format
+formatNon (Non c p) = formatPatchFL c F.$$ F.ascii ":" F.$$ formatPatch p
 
 -- |readNons is a parser that attempts to read a list of Nons.
-readNons :: (ReadPatch p, PatchListFormat p, PrimPatchBase p)
-         => Parser [Non p wX]
-readNons = peekfor (BC.pack "{{") rns (return [])
-  where rns = peekfor (BC.pack "}}") (return []) $
-              do Sealed ps <- readPatch'
-                 lexChar ':'
-                 Sealed p <- readPatch'
-                 (Non ps p :) `liftM` rns
+readNons :: (ReadPatches p, PrimPatchBase p) => Parser [Non p wX]
+readNons = (lexString (BC.pack "{{") >> go) <|> return []
+  where
+    go = none <|> some
+    none = lexString (BC.pack "}}") >> return []
+    some = (:) <$> readNon <*> go
 
 -- |readNon is a parser that attempts to read a single Non.
-readNon :: (ReadPatch p, PatchListFormat p, PrimPatchBase p)
-        => Parser (Non p wX)
-readNon = do Sealed ps <- readPatch'
-             let doReadPrim = do Sealed p <- readPatch'
-                                 return $ Non ps p
-             peekfor (BC.singleton ':') doReadPrim mzero
+readNon :: (ReadPatches p, PrimPatchBase p) => Parser (Non p wX)
+readNon = do
+    Sealed ps <- readPatchFL'
+    lexChar ':'
+    Sealed p <- readPatch'
+    return (Non ps p)
 
 -- |Nons are equal if their context patches are equal, and they have an equal
 -- prim patch.
diff --git a/src/Darcs/Patch/V2/Prim.hs b/src/Darcs/Patch/V2/Prim.hs
index e3c61bb5..07b383f8 100644
--- a/src/Darcs/Patch/V2/Prim.hs
+++ b/src/Darcs/Patch/V2/Prim.hs
@@ -5,24 +5,21 @@ module Darcs.Patch.V2.Prim ( Prim(..) ) where
 
 import Darcs.Prelude
 
+import Control.Monad ( (<=<) )
 import Data.Coerce (coerce )
 
 import Darcs.Patch.Annotate ( Annotate )
 import Darcs.Patch.Apply ( Apply(..) )
 import Darcs.Patch.Commute ( Commute(..) )
 import Darcs.Patch.FileHunk ( IsHunk )
-import Darcs.Patch.Format
-    ( PatchListFormat(..)
-    , ListFormat(ListFormatV2)
-    , FileNameFormat(FileNameFormatV2,FileNameFormatDisplay) )
+import Darcs.Patch.Format ( FormatPatch(..) )
 import Darcs.Patch.Inspect ( PatchInspect )
 import Darcs.Patch.Invert ( Invert )
 import Darcs.Patch.Merge ( CleanMerge )
-import Darcs.Patch.Read ( ReadPatch(..) )
+import Darcs.Patch.Read ( ReadPatch(..), ReadPatches(..), legacyReadPatchFL' )
 import Darcs.Patch.Repair ( RepairToFL(..) )
 import Darcs.Patch.Show
     ( ShowPatchBasic(..)
-    , ShowPatchFor(..)
     , ShowPatch(..)
     , ShowContextPatch(..)
     )
@@ -35,12 +32,15 @@ import Darcs.Patch.Witnesses.Sealed ( mapSeal )
 import Darcs.Patch.Prim.Class
     ( PrimConstruct(..), PrimCoalesce(..)
     , PrimDetails(..)
-    , PrimShow(..), PrimRead(..)
     , PrimApply(..)
     , PrimSift(..)
     , PrimMangleUnravelled(..)
     )
-import qualified Darcs.Patch.Prim.V1 as Base ( Prim )
+import qualified Darcs.Patch.Prim.V1 as Base ( Prim, formatPrim, readPrim )
+
+import Darcs.Util.ByteString ( decodeLocale )
+import Darcs.Util.Format ( userchunk )
+import Darcs.Util.Path ( anchorPath, decodeWhite, encodeWhite, floatPath )
 
 newtype Prim x y = Prim { unPrim :: Base.Prim x y } deriving
     ( Annotate
@@ -58,6 +58,8 @@ newtype Prim x y = Prim { unPrim :: Base.Prim x y } deriving
     , PrimMangleUnravelled
     , PrimSift
     , Show
+    , ShowContextPatch
+    , ShowPatchBasic
     )
 
 instance Show1 (Prim wX)
@@ -65,31 +67,22 @@ instance Show1 (Prim wX)
 instance Show2 Prim
 
 instance ReadPatch Prim where
-  readPatch' = fmap (mapSeal Prim) (readPrim FileNameFormatV2)
-
-fileNameFormat :: ShowPatchFor -> FileNameFormat
-fileNameFormat ForDisplay = FileNameFormatDisplay
-fileNameFormat ForStorage = FileNameFormatV2
-
-instance ShowPatchBasic Prim where
-  showPatch fmt = showPrim (fileNameFormat fmt) . unPrim
+  readPatch' = fmap (mapSeal Prim) (Base.readPrim decodePath)
+    where
+      decodePath = floatPath <=< decodeWhite . decodeLocale
 
-instance ShowContextPatch Prim where
-  showPatchWithContextAndApply fmt = showPrimWithContextAndApply (fileNameFormat fmt) . unPrim
+instance ReadPatches Prim where
+  readPatchFL' = legacyReadPatchFL'
 
 instance ShowPatch Prim where
   summary = plainSummaryPrim . unPrim
   summaryFL = plainSummaryPrims False
   thing _ = "change"
 
--- This instance is here so that FL Prim and RL Prim also get
--- ShowPatch instances, see Darcs.Patch.Viewing
-instance PatchListFormat Prim where
-  -- In principle we could use ListFormatDefault when prim /= V1 Prim patches,
-  -- as those are the only case where we need to support a legacy on-disk
-  -- format. In practice we don't expect RepoPatchV2 to be used with any other
-  -- argument anyway, so it doesn't matter.
-  patchListFormat = ListFormatV2
+instance FormatPatch Prim where
+  formatPatch = Base.formatPrim encodePath . unPrim
+    where
+      encodePath = userchunk . encodeWhite . anchorPath "."
 
 instance RepairToFL Prim where
   applyAndTryToFixFL = fmap coerce . applyAndTryToFixFL . unPrim
diff --git a/src/Darcs/Patch/V2/RepoPatch.hs b/src/Darcs/Patch/V2/RepoPatch.hs
index f387b216..31fbf83d 100644
--- a/src/Darcs/Patch/V2/RepoPatch.hs
+++ b/src/Darcs/Patch/V2/RepoPatch.hs
@@ -42,7 +42,7 @@ import Darcs.Patch.Conflict ( Conflict(..), combineConflicts, mangleOrFail )
 import Darcs.Patch.Debug
 import Darcs.Patch.Effect ( Effect(..) )
 import Darcs.Patch.FileHunk ( IsHunk(..) )
-import Darcs.Patch.Format ( PatchListFormat(..), ListFormat(ListFormatV2) )
+import Darcs.Patch.Format ( FormatPatch(..) )
 import Darcs.Patch.Ident ( PatchId )
 import Darcs.Patch.Invert ( invertFL, invertRL, Invert(..) )
 import Darcs.Patch.Merge ( CleanMerge(..), Merge(..), swapMerge )
@@ -52,7 +52,12 @@ import Darcs.Patch.FromPrim
     , PrimPatchBase(..)
     )
 import Darcs.Patch.Prim ( PrimPatch, applyPrimFL )
-import Darcs.Patch.Read ( bracketedFL, ReadPatch(..) )
+import Darcs.Patch.Read
+    ( ReadPatch(..)
+    , ReadPatches(..)
+    , readBracketedFL
+    , legacyReadPatchFL'
+    )
 import Darcs.Util.Parser ( skipSpace, string, choice )
 import Darcs.Patch.Repair ( mapMaybeSnd, RepairToFL(..), Check(..) )
 import Darcs.Patch.Apply ( Apply(..) )
@@ -61,8 +66,8 @@ import Darcs.Patch.Permutations ( commuteWhatWeCanFL, commuteWhatWeCanRL
                                 , genCommuteWhatWeCanRL, removeRL, removeFL
                                 , removeSubsequenceFL, nubFL, (=\~/=), (=/~\=) )
 import Darcs.Patch.Show
-    ( ShowPatch(..), ShowPatchBasic(..), ShowContextPatch(..), ShowPatchFor(..)
-    , displayPatch )
+    ( ShowContextPatch(..), ShowPatch(..), ShowPatchBasic(..)
+    , showPatch )
 import Darcs.Patch.Summary
     ( Summary(..)
     , ConflictState(..)
@@ -70,11 +75,27 @@ import Darcs.Patch.Summary
     , plainSummary
     )
 import Darcs.Patch.Unwind ( Unwind(..), mkUnwound )
-import Darcs.Patch.V2.Non ( Non(..), Nonable(..), unNon, showNons, showNon
-                          , readNons, readNon, commutePrimsOrAddToCtx
-                          , commuteOrAddToCtx, commuteOrAddToCtxRL
-                          , commuteOrRemFromCtx, commuteOrRemFromCtxFL
-                          , remNons, (*>), (>*), (*>>), (>>*) )
+import Darcs.Patch.V2.Non
+    ( Non(..)
+    , Nonable(..)
+    , commuteOrAddToCtx
+    , commuteOrAddToCtxRL
+    , commuteOrRemFromCtx
+    , commuteOrRemFromCtxFL
+    , commutePrimsOrAddToCtx
+    , readNon
+    , readNons
+    , remNons
+    , showNon
+    , showNons
+    , formatNon
+    , formatNons
+    , unNon
+    , (*>)
+    , (*>>)
+    , (>*)
+    , (>>*)
+    )
 import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
 import Darcs.Patch.Witnesses.Eq ( Eq2(..), EqCheck(..) )
 import Darcs.Patch.Witnesses.Ordered
@@ -86,6 +107,7 @@ import Darcs.Patch.Witnesses.Sealed
     , unseal )
 import Darcs.Patch.Witnesses.Show ( Show1, Show2, showsPrec2, appPrec )
 
+import qualified Darcs.Util.Format as F
 import Darcs.Util.Path ( AnchoredPath )
 import Darcs.Util.Printer ( Doc, renderString, blueText, redText, (<+>), ($$), vcat )
 
@@ -145,7 +167,7 @@ isForward p = case p of
     p@(Etacilpud _) -> justRedP "An inverse duplicate" p
     _ -> Nothing
   where
-    justRedP msg p = Just $ redText msg $$ displayPatch p
+    justRedP msg p = Just $ redText msg $$ showPatch p
 
 -- |'mergeUnravelled' is used when converting from Darcs V1 patches (Mergers)
 -- to Darcs V2 patches (Conflictors).
@@ -208,7 +230,7 @@ assertConsistent :: PrimPatch prim => RepoPatchV2 prim wX wY
                  -> RepoPatchV2 prim wX wY
 assertConsistent x = maybe x (error . renderString) $ do
     e <- isConsistent x
-    Just (redText "Inconsistent patch:" $$ displayPatch x $$ e)
+    Just (redText "Inconsistent patch:" $$ showPatch x $$ e)
 
 -- | @mergeAfterConflicting@ takes as input a sequence of conflicting patches
 -- @xxx@ (which therefore have no effect) and a sequence of primitive patches
@@ -271,7 +293,7 @@ geteff ix xx =
     case mergeConflictingNons ix of
         Nothing -> error $ renderString $
             redText "mergeConflictingNons failed in geteff: ix" $$
-            displayNons ix $$ redText "xx" $$ displayPatch xx
+            showNons ix $$ redText "xx" $$ showPatch xx
         Just rix ->
             case mergeAfterConflicting rix xx of
                 Just (a, x) ->
@@ -280,9 +302,9 @@ geteff ix xx =
                 Nothing ->
                     error $ renderString $
                         redText "mergeAfterConflicting failed in geteff" $$
-                        redText "where ix" $$ displayNons ix $$
-                        redText "and xx" $$ displayPatch xx $$
-                        redText "and rix" $$ displayPatch rix
+                        redText "where ix" $$ showNons ix $$
+                        redText "and xx" $$ showPatch xx $$
+                        redText "and rix" $$ showPatch rix
 
 xx2nons :: PrimPatch prim => [Non (RepoPatchV2 prim) wX] -> FL prim wX wY
         -> [Non (RepoPatchV2 prim) wX]
@@ -313,18 +335,18 @@ isConsistent (Conflictor im mm m@(Non deps _))
         Just $ redText "m doesn't conflict with mm in isConsistent"
     | any (\x -> any (x `conflictsWith`) nmm) im =
         Just $ redText "mm conflicts with im in isConsistent where nmm is" $$
-               displayNons nmm
+               showNons nmm
     | Nothing <- (nmm ++ im) `minus` toNons deps =
         Just $ redText "dependencies not in conflict:" $$
-               displayNons (toNons deps) $$
+               showNons (toNons deps) $$
                redText "compared with deps itself:" $$
-               displayPatch deps
+               showPatch deps
     | otherwise =
         case allConflictsWith m im of
             (im1, []) | im1 `eqSet` im -> Nothing
             (_, imnc) -> Just $ redText ("m doesn't conflict with im in "
                                          ++ "isConsistent. unconflicting:") $$
-                                displayNons imnc
+                                showNons imnc
     where (nmm, rmm) = geteff im mm
 
 everyoneConflicts :: PrimPatch prim => [Non (RepoPatchV2 prim) wX] -> Bool
@@ -540,7 +562,7 @@ nonHunkMatches :: PatchInspect prim => (BC.ByteString -> Bool)
                -> Non (RepoPatchV2 prim) wX -> Bool
 nonHunkMatches f (Non c x) = hunkMatches f c || hunkMatches f x
 
-toNons :: forall p wX wY . (Commute p, PatchListFormat p,
+toNons :: forall p wX wY . (Commute p,
        Nonable p, ShowPatchBasic (PrimOf p), ShowPatchBasic p)
        => FL p wX wY -> [Non p wX]
 toNons xs = map lastNon $ initsFL xs
@@ -555,9 +577,9 @@ toNons xs = map lastNon $ initsFL xs
                                   redText "Weird case in toNons" $$
                                   redText "please report this bug!" $$
                                   (case xxx of
-                                   z :> zs -> displayPatch (z :>: zs)) $$
-                                  redText "ds are" $$ displayPatch ds $$
-                                  redText "pp is" $$ displayPatch pp
+                                   z :> zs -> showPatch (z :>: zs)) $$
+                                  redText "ds are" $$ showPatch ds $$
+                                  redText "pp is" $$ showPatch pp
 
           reverseFoo :: (p :> FL p) wX wZ -> (RL p :> p) wX wZ
           reverseFoo (p :> ps) = rf NilRL p ps
@@ -826,13 +848,6 @@ instance PrimPatch prim => RepairToFL (RepoPatchV2 prim) where
         mapMaybeSnd (mapFL_FL Normal) `liftM` applyAndTryToFixFL p
     applyAndTryToFixFL x = do apply x; return Nothing
 
-instance PatchListFormat (RepoPatchV2 prim) where
-   -- In principle we could use ListFormatDefault when prim /= V1 Prim patches,
-   -- as those are the only case where we need to support a legacy on-disk
-   -- format. In practice we don't expect RepoPatchV2 to be used with any other
-   -- argument anyway, so it doesn't matter.
-    patchListFormat = ListFormatV2
-
 duplicate, etacilpud, conflictor, rotcilfnoc :: String
 duplicate = "duplicate"
 etacilpud = "etacilpud"
@@ -840,31 +855,52 @@ conflictor = "conflictor"
 rotcilfnoc = "rotcilfnoc"
 
 instance PrimPatch prim => ShowPatchBasic (RepoPatchV2 prim) where
-    showPatch f (Duplicate d) = blueText duplicate $$ showNon f d
-    showPatch f (Etacilpud d) = blueText etacilpud $$ showNon f d
-    showPatch f (Normal p) = showPatch f p
-    showPatch f (Conflictor i NilFL p) =
-        blueText conflictor <+> showNons f i <+> blueText "[]" $$ showNon f p
-    showPatch f (Conflictor i cs p) =
-        blueText conflictor <+> showNons f i <+> blueText "[" $$
-        showFL f cs $$
+    showPatch (Duplicate d) = blueText duplicate $$ showNon d
+    showPatch (Etacilpud d) = blueText etacilpud $$ showNon d
+    showPatch (Normal p) = showPatch p
+    showPatch (Conflictor i NilFL p) =
+        blueText conflictor <+> showNons i <+> blueText "[]" $$ showNon p
+    showPatch (Conflictor i cs p) =
+        blueText conflictor <+> showNons i <+> blueText "[" $$
+        showFL cs $$
         blueText "]" $$
-        showNon f p
-    showPatch f (InvConflictor i NilFL p) =
-        blueText rotcilfnoc <+> showNons f i <+> blueText "[]" $$ showNon f p
-    showPatch f (InvConflictor i cs p) =
-        blueText rotcilfnoc <+> showNons f i <+> blueText "[" $$
-        showFL f cs $$
+        showNon p
+    showPatch (InvConflictor i NilFL p) =
+        blueText rotcilfnoc <+> showNons i <+> blueText "[]" $$ showNon p
+    showPatch (InvConflictor i cs p) =
+        blueText rotcilfnoc <+> showNons i <+> blueText "[" $$
+        showFL cs $$
         blueText "]" $$
-        showNon f p
+        showNon p
+
+instance PrimPatch prim => FormatPatch (RepoPatchV2 prim) where
+    formatPatch (Duplicate d) = F.ascii duplicate F.$$ formatNon d
+    formatPatch (Etacilpud d) = F.ascii etacilpud F.$$ formatNon d
+    formatPatch (Normal p) = formatPatch p
+    formatPatch (Conflictor i NilFL p) =
+        F.ascii conflictor F.<+> formatNons i F.<+> F.ascii "[]" F.$$ formatNon p
+    formatPatch (Conflictor i cs p) =
+        F.vcat
+            [ F.ascii conflictor F.<+> formatNons i F.<+> F.ascii "["
+            , formatPatchFL cs
+            , F.ascii "]"
+            , formatNon p
+            ]
+    formatPatch (InvConflictor i NilFL p) =
+        F.ascii rotcilfnoc F.<+> formatNons i F.<+> F.ascii "[]" F.$$ formatNon p
+    formatPatch (InvConflictor i cs p) =
+        F.ascii rotcilfnoc F.<+> formatNons i F.<+> F.ascii "[" F.$$
+        formatPatchFL cs F.$$
+        F.ascii "]" F.$$
+        formatNon p
 
 instance PrimPatch prim => ShowContextPatch (RepoPatchV2 prim) where
-    showPatchWithContextAndApply f (Normal p) = showPatchWithContextAndApply f p
-    showPatchWithContextAndApply f p = apply p >> return (showPatch f p)
+    showPatchWithContextAndApply (Normal p) = showPatchWithContextAndApply p
+    showPatchWithContextAndApply p = apply p >> return (showPatch p)
 
 instance PrimPatch prim => ShowPatch (RepoPatchV2 prim) where
     summary = plainSummary
-    summaryFL = plainSummary
+    summaryFL = plainSummary -- FIXME shouldn't this be plainSummaryFL ?
     thing _ = "change"
 
 instance PrimPatch prim => ReadPatch (RepoPatchV2 prim) where
@@ -873,7 +909,7 @@ instance PrimPatch prim => ReadPatch (RepoPatchV2 prim) where
         let str = string . BC.pack
             readConflictorPs = do
                i <- readNons
-               ps <- bracketedFL readPatch' '[' ']'
+               ps <- readBracketedFL readPatch' '[' ']'
                p <- readNon
                return (i, ps, p)
         choice [ do str duplicate
@@ -892,6 +928,9 @@ instance PrimPatch prim => ReadPatch (RepoPatchV2 prim) where
                     return $ Sealed $ Normal p
                ]
 
+instance PrimPatch prim => ReadPatches (RepoPatchV2 prim) where
+    readPatchFL' = legacyReadPatchFL'
+
 instance Show2 prim => Show (RepoPatchV2 prim wX wY) where
     showsPrec d (Normal prim) =
         showParen (d > appPrec) $ showString "Normal " . showsPrec2 (appPrec + 1) prim
@@ -933,12 +972,10 @@ instance PrimPatch prim => Effect (RepoPatchV2 prim) where
     effect (InvConflictor _ e _) = e
 
 instance IsHunk prim => IsHunk (RepoPatchV2 prim) where
-    isHunk rp = do Normal p <- return rp
-                   isHunk p
-
-displayNons :: (PatchListFormat p, ShowPatchBasic p, PrimPatchBase p) =>
-               [Non p wX] -> Doc
-displayNons p = showNons ForDisplay p
+    type ExtraData (RepoPatchV2 prim) = ExtraData prim
+    isHunk (Normal p) = isHunk p
+    isHunk _ = Nothing
+    fromHunk = Normal . fromHunk
 
-showFL :: ShowPatchBasic p => ShowPatchFor -> FL p wX wY -> Doc
-showFL f = vcat . mapFL (showPatch f)
+showFL :: ShowPatchBasic p => FL p wX wY -> Doc
+showFL = vcat . mapFL showPatch
diff --git a/src/Darcs/Patch/V3.hs b/src/Darcs/Patch/V3.hs
index 29065c64..10e9aa52 100644
--- a/src/Darcs/Patch/V3.hs
+++ b/src/Darcs/Patch/V3.hs
@@ -5,12 +5,14 @@ import Darcs.Prelude
 
 import Darcs.Patch.FromPrim ( FromPrim(..) )
 import Darcs.Patch.Prim.Named
-  ( PrimPatchId
-  , anonymousNamedPrim, namedPrim, positivePrimPatchIds
-  )
-import Darcs.Patch.Witnesses.Ordered ( FL(..) )
+    ( PrimPatchId
+    , anonymousNamedPrim
+    , namedPrim
+    , positivePrimPatchIds
+    )
 import qualified Darcs.Patch.V3.Core as Core ( RepoPatchV3(..) )
 import Darcs.Patch.V3.Resolution ()
+import Darcs.Patch.Witnesses.Ordered ( FL(..) )
 
 type RepoPatchV3 = Core.RepoPatchV3 PrimPatchId
 
diff --git a/src/Darcs/Patch/V3/Contexted.hs b/src/Darcs/Patch/V3/Contexted.hs
index a835b63d..0793b923 100644
--- a/src/Darcs/Patch/V3/Contexted.hs
+++ b/src/Darcs/Patch/V3/Contexted.hs
@@ -24,6 +24,7 @@ module Darcs.Patch.V3.Contexted
       -- * 'ReadPatch' and 'ShowPatch' helpers
     , showCtx
     , readCtx
+    , formatCtx
       -- * Properties
     , prop_ctxInvariants
     , prop_ctxEq
@@ -37,15 +38,15 @@ import Data.Maybe ( isNothing, isJust )
 import Darcs.Prelude
 
 import Darcs.Patch.Commute
-import Darcs.Patch.Format ( PatchListFormat(..) )
+import Darcs.Patch.Format ( FormatPatch(..) )
 import Darcs.Patch.Ident
 import Darcs.Patch.Invert
 import Darcs.Patch.Inspect
 import Darcs.Patch.Merge ( CleanMerge(..) )
-import Darcs.Patch.Read ( ReadPatch(..) )
+import Darcs.Patch.Read ( ReadPatch(..), ReadPatches(..) )
 import Darcs.Patch.Permutations ( (=\~/=) )
 import Darcs.Util.Parser ( Parser, lexString )
-import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatchFor )
+import Darcs.Patch.Show ( ShowPatchBasic(..) )
 import Darcs.Patch.Viewing ()
 import Darcs.Patch.Witnesses.Eq
 import Darcs.Patch.Witnesses.Ordered
@@ -54,6 +55,7 @@ import Darcs.Patch.Witnesses.Show
 
 import Darcs.Util.Path ( AnchoredPath )
 import Darcs.Util.Printer
+import qualified Darcs.Util.Format as F
 
 {-
 | (Definition 10.1) A 'Contexted' patch is a patch transferred to, or viewed
@@ -238,15 +240,16 @@ ctxHunkMatches f (Contexted ps p) = hunkMatches f ps || hunkMatches f p
 -- context. But this means that we need access to the patches preceding us.
 -- So these functions would no longer be independent of context.
 
-showCtx :: (ShowPatchBasic p, PatchListFormat p)
-        => ShowPatchFor -> Contexted p wX -> Doc
-showCtx f (Contexted c p) =
-  hiddenPrefix "|" (showPatch f c) $$ hiddenPrefix "|" (blueText ":") $$ showPatch f p
+showCtx :: ShowPatchBasic p => Contexted p wX -> Doc
+showCtx (Contexted c p) =
+  hiddenPrefix "|" (showPatch c) $$ hiddenPrefix "|" (blueText ":") $$ showPatch p
 
-readCtx :: (ReadPatch p, PatchListFormat p)
-        => Parser (Contexted p wX)
+formatCtx :: FormatPatch p => Contexted p wX -> F.Format
+formatCtx (Contexted c p) = F.vcat [formatPatchFL c, F.ascii ":", formatPatch p]
+
+readCtx :: ReadPatches p => Parser (Contexted p wX)
 readCtx = do
-  Sealed ps <- readPatch'
+  Sealed ps <- readPatchFL'
   lexString (BC.pack ":")
   Sealed p <- readPatch'
   return $ Contexted ps p
diff --git a/src/Darcs/Patch/V3/Core.hs b/src/Darcs/Patch/V3/Core.hs
index 57028794..f8e730ba 100644
--- a/src/Darcs/Patch/V3/Core.hs
+++ b/src/Darcs/Patch/V3/Core.hs
@@ -41,7 +41,7 @@ import Darcs.Patch.CommuteFn ( CommuteFn )
 import Darcs.Patch.CommuteNoConflicts ( CommuteNoConflicts(..) )
 import Darcs.Patch.Debug ( PatchDebug(..) )
 import Darcs.Patch.FileHunk ( IsHunk(..) )
-import Darcs.Patch.Format ( ListFormat(ListFormatV3) )
+import Darcs.Patch.Format ( FormatPatch(..) )
 import Darcs.Patch.FromPrim ( ToPrim(..) )
 import Darcs.Patch.Ident
     ( Ident(..)
@@ -63,7 +63,7 @@ import Darcs.Patch.Merge
     )
 import Darcs.Patch.Prim ( PrimPatch, applyPrimFL, sortCoalesceFL )
 import Darcs.Patch.Prim.WithName ( PrimWithName, wnPatch )
-import Darcs.Patch.Read ( bracketedFL )
+import Darcs.Patch.Read ( readBracketedFL )
 import Darcs.Patch.Repair (RepairToFL(..), Check(..) )
 import Darcs.Patch.RepoPatch
     ( Apply(..)
@@ -71,12 +71,12 @@ import Darcs.Patch.RepoPatch
     , Effect(..)
     , Eq2(..)
     , PatchInspect(..)
-    , PatchListFormat(..)
     , PrimPatchBase(..)
     , ReadPatch(..)
+    , ReadPatches(..)
     , Summary(..)
     )
-import Darcs.Patch.Show hiding ( displayPatch )
+import Darcs.Patch.Show ( ShowContextPatch(..), ShowPatch(..), ShowPatchBasic(..) )
 import Darcs.Patch.Summary
     ( ConflictState(..)
     , IsConflictedPrim(..)
@@ -97,8 +97,8 @@ import Darcs.Patch.V3.Contexted
     , ctxToFL
     , ctxTouches
     , ctxHunkMatches
-    , showCtx
     , readCtx
+    , formatCtx
     )
 import Darcs.Patch.Witnesses.Eq ( EqCheck(..) )
 import Darcs.Patch.Witnesses.Ordered
@@ -119,11 +119,12 @@ import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP1 )
 
 import Darcs.Test.TestOnly
 
+import qualified Darcs.Util.Format as F
 import Darcs.Util.Parser ( string, lexString, choice, skipSpace )
 import Darcs.Util.Printer
     ( Doc
+    , Print
     , ($$)
-    , (<+>)
     , blueText
     , redText
     , renderString
@@ -179,8 +180,11 @@ instance SignedId name => Ident (RepoPatchV3 name prim) where
 
 -- We only use displayPatch for error messages here, so it makes sense
 -- to use the storage format that contains the patch names.
-displayPatch :: ShowPatchBasic p => p wX wY -> Doc
-displayPatch p = showPatch ForStorage p
+displayPatch :: FormatPatch p => p wX wY -> Doc
+displayPatch = F.toDoc . formatPatch
+
+displayPatchFL :: FormatPatch p => FL p wX wY -> Doc
+displayPatchFL = F.toDoc . formatPatchFL
 
 instance (SignedId name, StorableId name, PrimPatch prim) =>
          CleanMerge (RepoPatchV3 name prim) where
@@ -263,8 +267,8 @@ instance (SignedId name, StorableId name, PrimPatch prim) =>
             error $ renderString $ redText "uncommon effects can't be merged cleanly:"
               $$ redText "lhs:" $$ displayPatch lhs
               $$ redText "rhs:" $$ displayPatch rhs
-              $$ redText "r:" $$ displayPatch r
-              $$ redText "s:" $$ displayPatch s
+              $$ redText "r:" $$ displayPatchFL r
+              $$ redText "s:" $$ displayPatchFL s
 
 -- * CommuteNoConflicts
 
@@ -338,7 +342,7 @@ commuteConflicting (Prim p :> Conflictor s y cq)
             $ redText "commuteConflicting: cannot remove (invert lhs):"
             $$ displayPatch (invert p)
             $$ redText "from effect of rhs:"
-            $$ displayPatch s
+            $$ displayPatchFL s
         Just r ->
           let cp = ctxAddInvFL r (ctx p)
           in Just (Conflictor r (cp -| y) cq :> Conflictor NilFL (S.singleton cq) cp)
@@ -367,7 +371,7 @@ commuteConflicting (lhs@(Conflictor r x cp) :> rhs@(Conflictor NilFL y cq))
           -- rhs would also have to conflict with the patch x, again in
           -- contradiction to our case assumption. QED
           error $ renderString $ redText "remaining context in commute:"
-            $$ displayPatch c'
+            $$ displayPatchFL c'
             $$ redText "lhs:" $$ displayPatch lhs
             $$ redText "rhs:" $$ displayPatch rhs
 -- conflicting conflictors where the rhs conflicts with lhs but
@@ -426,7 +430,11 @@ instance PatchInspect prim => PatchInspect (RepoPatchV3 name prim) where
 instance (SignedId name, Eq2 prim, Commute prim) => Eq2 (RepoPatchV3 name prim) where
     (Prim p) =\/= (Prim q) = p =\/= q
     (Conflictor r x cp) =\/= (Conflictor s y cq)
-        | IsEq <- r =\^/= s -- more efficient than IsEq <- r =\/= s
+        | IsEq <- r =\^/= s
+        -- =\^/= is not only more efficient than r =\/= s but also
+        -- semantically correct, since we want to treat different
+        -- orderings of the effect as equal here, same as we do for
+        -- the contexts in cp and cq.
         , x == y
         , cp == cq = IsEq
     _ =\/= _ = NotEq
@@ -461,13 +469,11 @@ instance PrimPatch prim => Apply (RepoPatchV3 name prim) where
   apply = applyPrimFL . effect
   unapply = applyPrimFL . invert . effect
 
-instance PatchListFormat (RepoPatchV3 name prim) where
-  patchListFormat = ListFormatV3
-
-instance IsHunk prim => IsHunk (RepoPatchV3 name prim) where
-  isHunk rp = do
-    Prim p <- return rp
-    isHunk p
+instance (IsHunk prim, Print name) => IsHunk (RepoPatchV3 name prim) where
+  type ExtraData (RepoPatchV3 name prim) = (name, ExtraData prim)
+  isHunk (Prim p) = isHunk p
+  isHunk _ = Nothing
+  fromHunk = Prim . fromHunk
 
 instance Summary (RepoPatchV3 name prim) where
   conflictedEffect (Conflictor _ _ (ctxView -> Sealed (_ :> p))) = [IsC Conflicted (wnPatch p)]
@@ -493,7 +499,36 @@ instance PrimPatch prim => Check (RepoPatchV3 name prim)
   -- use the default implementation for method isInconsistent
 
 instance PrimPatch prim => RepairToFL (RepoPatchV3 name prim)
-  -- use the default implementation for method applyAndTryToFixFL
+  {- TODO [V3INTEGRATION]:
+
+  For V1 and V2 we only repair (wrapped) prim patches, and not the
+  ingredients of Mergers or Conflictors (or even Duplicates). This is bad
+  enough, since patches conflicting with or duplicating repaired prims now
+  become invalid.
+
+  For Conflictors and Mergers it is unclear whether fixing non-prim patches
+  by recursively fixing their ingredients makes sense, since the earlier
+  (unconflicted) patch may no longer conflict after being repaired, thus
+  again invalidating the conflicted patches. The only way to be sure would
+  be to re-calculate the merge after (recursively!) un-merging and fixing
+  the resulting prims, something that at least for V1 and V2 seems
+  pointless, as it will likely run into /actual/ commutation bugs or
+  exponential blow-ups.
+
+  But we should at least detect this when running repair, i.e. by checking
+  all ingredients of complex (non-prim) patches and failing the whole
+  operation in that case.
+
+  V2 Duplicates are a special thing: they could be easily repaired, I can't
+  understand why this was never done. TODO implement that.
+
+  A simple way to guarantee consistent repairs (inside a single repo) would
+  be to flatten conflictors that conflict with repaired patches to their
+  effect. Since repair keeps patch identities, this can of course cause
+  problems when we interact with other repos that still have the unrepaired
+  patches. This is, however, already the case today and can easily be fixed
+  by repairing the other repos, too. (Flattened conflictors will look the
+  same in all repos.) -}
 
 instance (SignedId name, StorableId name, PrimPatch prim)
   => ShowPatch (RepoPatchV3 name prim) where
@@ -505,8 +540,8 @@ instance (SignedId name, StorableId name, PrimPatch prim)
 instance (SignedId name, StorableId name, PrimPatch prim)
   => ShowContextPatch (RepoPatchV3 name prim) where
 
-  showPatchWithContextAndApply f (Prim p) = showPatchWithContextAndApply f p
-  showPatchWithContextAndApply f p = apply p >> return (showPatch f p)
+  showPatchWithContextAndApply (Prim p) = showPatchWithContextAndApply p
+  showPatchWithContextAndApply p = apply p >> return (showPatch p)
 
 -- * Read and Write
 
@@ -523,47 +558,52 @@ instance (SignedId name, StorableId name, PrimPatch prim)
       ]
     where
       readContent = do
-        r <- bracketedFL readPatch' '[' ']'
+        r <- readBracketedFL readPatch' '[' ']'
         x <- readCtxSet
         p <- readCtx
         return (r, x, p)
-      readCtxSet = (lexString (BC.pack "{{") >> go) <|> pure S.empty
+      readCtxSet = lexString (BC.pack "{{") >> go
         where
-          go = (lexString (BC.pack "}}") >> pure S.empty) <|> S.insert <$> readCtx <*> go
+          go =
+            (lexString (BC.pack "}}") >> pure S.empty)
+            <|>
+            (S.insert <$> readCtx <*> go)
+
+instance (SignedId name, StorableId name, PrimPatch prim)
+  => ReadPatches (RepoPatchV3 name prim)
 
 instance (SignedId name, StorableId name, PrimPatch prim)
   => ShowPatchBasic (RepoPatchV3 name prim) where
 
-  showPatch fmt rp =
+  showPatch rp =
     case rp of
-      Prim p -> showPatch fmt p
+      Prim p -> showPatch p
       Conflictor r x cp ->
-        case fmt of
-          ForStorage -> blueText "conflictor" <+> showContent r x cp
-          ForDisplay ->
-            vcat
-            [ blueText "conflictor"
-            , vcat (mapFL displayPatch r)
-            , redText "v v v v v v v"
-            , vcat [ displayCtx p $$ redText "*************" | p <- S.toList x ]
-            , displayCtx cp
-            , redText "^ ^ ^ ^ ^ ^ ^"
-            ]
+        vcat
+          [ blueText "conflictor"
+          , vcat (mapFL showPatch r)
+          , redText "v v v v v v v"
+          , vcat [ displayCtx p $$ redText "*************" | p <- S.toList x ]
+          , displayCtx cp
+          , redText "^ ^ ^ ^ ^ ^ ^"
+          ]
     where
-      showContent r x cp = showEffect r <+> showCtxSet x $$ showCtx fmt cp
-      showEffect NilFL = blueText "[]"
-      showEffect ps = blueText "[" $$ vcat (mapFL (showPatch fmt) ps) $$ blueText "]"
-      showCtxSet xs =
-        case S.minView xs of
-          Nothing -> mempty
-          Just _ ->
-            blueText "{{"
-              $$ vcat (map (showCtx fmt) (S.toAscList xs))
-              $$ blueText "}}"
       displayCtx c =
-        -- need to use ForStorage to see the prim patch IDs
-        showId ForStorage (ctxId c) $$
-        unseal (showPatch ForDisplay . sortCoalesceFL . mapFL_FL wnPatch) (ctxToFL c)
+        showId (ctxId c) $$
+        unseal (showPatch . sortCoalesceFL . mapFL_FL wnPatch) (ctxToFL c)
+
+instance (StorableId name, FormatPatch prim) =>
+         FormatPatch (RepoPatchV3 name prim) where
+  formatPatch rp =
+    case rp of
+      Prim p -> formatPatch p
+      Conflictor r x cp -> F.ascii "conflictor" F.<+> formatContent r x cp
+    where
+      formatContent r x cp = F.hsep [formatEffect r, formatCtxSet x, formatCtx cp]
+      formatEffect NilFL = F.ascii "[]"
+      formatEffect ps = F.vcat [F.ascii "[", formatPatchFL ps, F.ascii "]"]
+      formatCtxSet xs =
+        F.vcat [F.ascii "{{", F.vcat (map formatCtx (S.toAscList xs)), F.ascii "}}"]
 
 -- * Local helper functions
 
diff --git a/src/Darcs/Patch/Viewing.hs b/src/Darcs/Patch/Viewing.hs
index f5789298..51122e2f 100644
--- a/src/Darcs/Patch/Viewing.hs
+++ b/src/Darcs/Patch/Viewing.hs
@@ -28,13 +28,11 @@ import qualified Data.ByteString as B ( null )
 import Darcs.Patch.Apply ( Apply(..), ObjectIdOfPatch )
 import Darcs.Patch.ApplyMonad ( ApplyMonad(..) )
 import Darcs.Patch.FileHunk ( FileHunk(..), IsHunk(..), showContextFileHunk )
-import Darcs.Patch.Format ( FileNameFormat(..), ListFormat(..), PatchListFormat(..) )
 import Darcs.Patch.Object ( ObjectId(..), ObjectIdOf )
 import Darcs.Patch.Show
     ( ShowContextPatch(..)
     , ShowPatch(..)
     , ShowPatchBasic(..)
-    , ShowPatchFor(..)
     )
 import Darcs.Patch.Witnesses.Ordered
     ( FL(..)
@@ -45,7 +43,7 @@ import Darcs.Patch.Witnesses.Ordered
     , reverseRL
     )
 import Darcs.Util.ByteString ( linesPS )
-import Darcs.Util.Printer ( Doc, blueText, empty, vcat, ($$) )
+import Darcs.Util.Printer ( Print(..), Doc, empty, vcat, ($$) )
 
 showContextSeries
   :: forall p m wX wY
@@ -55,43 +53,39 @@ showContextSeries
      , ApplyMonad (ApplyState p) m
      , ObjectId (ObjectIdOfPatch p)
      )
-  => ShowPatchFor
-  -> FileNameFormat
-  -> FL p wX wY
+  => FL p wX wY
   -> m Doc
-showContextSeries use fmt = scs Nothing
+showContextSeries = scs Nothing
   where
-    scs :: Maybe (FileHunk (ObjectIdOfPatch p) wA wB) -> FL p wB wC -> m Doc
+    scs :: Maybe (FileHunk (ExtraData p) (ObjectIdOfPatch p) wA wB) -> FL p wB wC -> m Doc
     scs pold (p :>: ps) = do
         case isHunk p of
             Nothing -> do
-                a <- showPatchWithContextAndApply use p
+                a <- showPatchWithContextAndApply p
                 b <- scs Nothing ps
                 return $ a $$ b
             Just fh -> case ps of
                 NilFL -> do
-                  r <- coolContextHunk fmt pold fh Nothing
+                  r <- coolContextHunk pold fh Nothing
                   apply p
                   return r
                 (p2 :>: _) -> do
-                    a <- coolContextHunk fmt pold fh (isHunk p2)
+                    a <- coolContextHunk pold fh (isHunk p2)
                     apply p
                     b <- scs (Just fh) ps
                     return $ a $$ b
     scs _ NilFL = return empty
 
 showContextHunk
-  :: (ApplyMonad state m, oid ~ ObjectIdOf state, ObjectId oid)
-  => FileNameFormat
-  -> FileHunk oid wX wY
+  :: (ApplyMonad state m, oid ~ ObjectIdOf state, ObjectId oid, Print xd)
+  => FileHunk xd oid wX wY
   -> m Doc
-showContextHunk fmt h = coolContextHunk fmt Nothing h Nothing
+showContextHunk h = coolContextHunk Nothing h Nothing
 
-coolContextHunk :: (ApplyMonad state m, oid ~ ObjectIdOf state, ObjectId oid)
-                => FileNameFormat
-                -> Maybe (FileHunk oid wA wB) -> FileHunk oid wB wC
-                -> Maybe (FileHunk oid wC wD) -> m Doc
-coolContextHunk fmt prev fh@(FileHunk f l o n) next = do
+coolContextHunk :: (ApplyMonad state m, oid ~ ObjectIdOf state, ObjectId oid, Print xd)
+                => Maybe (FileHunk xd oid wA wB) -> FileHunk xd oid wB wC
+                -> Maybe (FileHunk xd oid wC wD) -> m Doc
+coolContextHunk prev fh@(FileHunk _ f l o n) next = do
     ls <- linesPS <$> readFilePS f
     let pre = take numpre $ drop (l - numpre - 1) ls
         -- This removes the last line if that is empty. This is because if a
@@ -103,57 +97,31 @@ coolContextHunk fmt prev fh@(FileHunk f l o n) next = do
                 | B.null x -> reverse xs
             _ -> ls
         post = take numpost $ drop (max 0 $ l + length o - 1) cleanedls
-    return $ showContextFileHunk fmt pre fh post
+    return $ showContextFileHunk pre fh post
   where
     numpre = case prev of
-        Just (FileHunk f' lprev _ nprev)
+        Just (FileHunk _ f' lprev _ nprev)
             | f' == f && l - (lprev + length nprev + 3) < 3 && lprev < l
             -> max 0 $ l - (lprev + length nprev + 3)
         _ -> if l >= 4 then 3 else l - 1
     numpost = case next of
-        Just (FileHunk f' lnext _ _)
+        Just (FileHunk _ f' lnext _ _)
             | f' == f && lnext < l + length n + 4 && lnext > l
             -> lnext - (l + length n)
         _ -> 3
 
-instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (FL p) where
-    showPatch ForDisplay = vcat . mapFL (showPatch ForDisplay)
-    showPatch ForStorage = showPatchInternal patchListFormat
-      where
-        showPatchInternal :: ListFormat p -> FL p wX wY -> Doc
-        showPatchInternal ListFormatV1 (p :>: NilFL) = (showPatch ForStorage) p
-        showPatchInternal ListFormatV1 NilFL = blueText "{" $$ blueText "}"
-        showPatchInternal ListFormatV1 ps = blueText "{"
-                                            $$ vcat (mapFL (showPatch ForStorage) ps)
-                                            $$ blueText "}"
-        showPatchInternal ListFormatV2 ps = vcat (mapFL (showPatch ForStorage) ps)
-        showPatchInternal ListFormatDefault ps = vcat (mapFL (showPatch ForStorage) ps)
-        showPatchInternal ListFormatV3 ps = vcat (mapFL (showPatch ForStorage) ps)
+instance ShowPatchBasic p => ShowPatchBasic (FL p) where
+    showPatch = vcat . mapFL showPatch
 
 instance ( Apply p
          , IsHunk p
-         , PatchListFormat p
          , ShowContextPatch p
          , ObjectId (ObjectIdOfPatch p)
          ) =>
          ShowContextPatch (FL p) where
-    showPatchWithContextAndApply ForDisplay = showContextSeries ForDisplay FileNameFormatDisplay
-    showPatchWithContextAndApply ForStorage = showContextPatchInternal patchListFormat
-      where
-        showContextPatchInternal :: (ApplyMonad (ApplyState (FL p)) m)
-                                 => ListFormat p -> FL p wX wY -> m Doc
-        showContextPatchInternal ListFormatV1 (p :>: NilFL) =
-            showPatchWithContextAndApply ForStorage p
-        showContextPatchInternal ListFormatV1 NilFL =
-            return $ blueText "{" $$ blueText "}"
-        showContextPatchInternal ListFormatV1 ps = do
-            x <- showContextSeries ForStorage FileNameFormatV1 ps
-            return $ blueText "{" $$ x $$ blueText "}"
-        showContextPatchInternal ListFormatV2 ps = showContextSeries ForStorage FileNameFormatV2 ps
-        showContextPatchInternal ListFormatDefault ps = showContextSeries ForStorage FileNameFormatV2 ps
-        showContextPatchInternal ListFormatV3 ps = return $ showPatch ForStorage ps
-
-instance (PatchListFormat p, ShowPatch p) => ShowPatch (FL p) where
+    showPatchWithContextAndApply = showContextSeries
+
+instance ShowPatch p => ShowPatch (FL p) where
     content = vcat . mapFL content
 
     description = vcat . mapFL description
@@ -169,14 +137,14 @@ instance (PatchListFormat p, ShowPatch p) => ShowPatch (FL p) where
 
     things = thing
 
-instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (RL p) where
-    showPatch f = showPatch f . reverseRL
+instance ShowPatchBasic p => ShowPatchBasic (RL p) where
+    showPatch = showPatch . reverseRL
 
-instance (ShowContextPatch p, Apply p, IsHunk p, PatchListFormat p, ObjectId (ObjectIdOfPatch p))
+instance (ShowContextPatch p, Apply p, IsHunk p, ObjectId (ObjectIdOfPatch p))
         => ShowContextPatch (RL p) where
-    showPatchWithContextAndApply use = showPatchWithContextAndApply use . reverseRL
+    showPatchWithContextAndApply = showPatchWithContextAndApply . reverseRL
 
-instance (PatchListFormat p, ShowPatch p) => ShowPatch (RL p) where
+instance ShowPatch p => ShowPatch (RL p) where
     content = content . reverseRL
 
     description = description . reverseRL
diff --git a/src/Darcs/Prelude.hs b/src/Darcs/Prelude.hs
index 10de5be0..9c39738d 100644
--- a/src/Darcs/Prelude.hs
+++ b/src/Darcs/Prelude.hs
@@ -59,6 +59,9 @@ import Prelude hiding
     ,
       -- used by various code for no particularly good reason
       lookup, pred
+
+    , -- method of class Print
+      print
     )
 
 import Control.Applicative ( Applicative(..), (<$>), (<*>) )
diff --git a/src/Darcs/Repository.hs b/src/Darcs/Repository.hs
index fc1e29fc..18af650e 100644
--- a/src/Darcs/Repository.hs
+++ b/src/Darcs/Repository.hs
@@ -21,10 +21,8 @@ module Darcs.Repository
     , AccessType(..)
     , repoLocation
     , repoFormat
-    , repoPristineType
     , repoCache
     , RepoFormat(..)
-    , PristineType(..)
     , HashedDir(..)
     , Cache
     , CacheLoc(..)
@@ -55,9 +53,10 @@ module Darcs.Repository
     , tentativelyAddPatches
     , tentativelyRemovePatches
     , setTentativePending
-    , tentativelyRemoveFromPW
+    , tentativelyRemoveFromPending
     , withManualRebaseUpdate
     , tentativelyMergePatches
+    , oldTentativelyMergePatches
     , considerMergeToWorking
     , revertRepositoryChanges
     , UpdatePending(..)
@@ -124,7 +123,7 @@ import Darcs.Repository.Transaction
     , finalizeRepositoryChanges
     )
 import Darcs.Repository.Traverse ( cleanRepository )
-import Darcs.Repository.Pending ( setTentativePending, tentativelyRemoveFromPW )
+import Darcs.Repository.Pending ( setTentativePending, tentativelyRemoveFromPending )
 import Darcs.Repository.Working
     ( applyToWorking
     , setAllScriptsExecutable
@@ -139,9 +138,11 @@ import Darcs.Repository.Job
     , withUMaskFlag
     )
 import Darcs.Repository.Rebase ( withManualRebaseUpdate )
-import Darcs.Repository.Merge( tentativelyMergePatches
-                             , considerMergeToWorking
-                             )
+import Darcs.Repository.Merge
+    ( considerMergeToWorking
+    , oldTentativelyMergePatches
+    , tentativelyMergePatches
+    )
 import Darcs.Util.Cache
     ( Cache
     , CacheLoc(..)
@@ -155,11 +156,9 @@ import Darcs.Util.Cache
 import Darcs.Repository.InternalTypes
     ( Repository
     , AccessType(..)
-    , PristineType(..)
     , modifyCache
     , repoLocation
     , repoFormat
-    , repoPristineType
     , repoCache
     )
 import Darcs.Repository.Clone
diff --git a/src/Darcs/Repository/ApplyPatches.hs b/src/Darcs/Repository/ApplyPatches.hs
index 5a311361..897ebba9 100644
--- a/src/Darcs/Repository/ApplyPatches.hs
+++ b/src/Darcs/Repository/ApplyPatches.hs
@@ -15,7 +15,6 @@
 -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 -- Boston, MA 02110-1301, USA.
 
-{-# OPTIONS_GHC -Wno-missing-methods #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 module Darcs.Repository.ApplyPatches
@@ -60,10 +59,13 @@ newtype DefaultIO a = DefaultIO { runDefaultIO :: IO a }
     deriving (Functor, Applicative, Monad, MonadThrow)
 
 instance ApplyMonad Tree DefaultIO where
+    readFilePS path = mReadFilePS path
 
 instance ApplyMonadTree DefaultIO where
+    mDoesFileExist = DefaultIO . doesFileExist . realPath
     mDoesDirectoryExist = DefaultIO . doesDirectoryExist . realPath
     mChangePref a b c = DefaultIO $ changePrefval a b c
+    mReadFilePS = DefaultIO . B.readFile . realPath
     mModifyFilePS f j = DefaultIO $ B.readFile (realPath f) >>= runDefaultIO . j >>= writeAtomicFilePS (realPath f)
     mCreateDirectory = DefaultIO . createDirectory . realPath
     mCreateFile f = DefaultIO $
@@ -127,8 +129,10 @@ runDefault action =
       "\npatches in your repo, and perhaps 'darcs repair' to fix them."
 
 instance TolerantMonad m => ApplyMonad Tree (TolerantWrapper m) where
+    readFilePS path = mReadFilePS path
 
 instance TolerantMonad m => ApplyMonadTree (TolerantWrapper m) where
+    mDoesFileExist = runTM . runDefaultIO . mDoesFileExist
     mDoesDirectoryExist d = runTM $ runDefaultIO $ mDoesDirectoryExist d
     mReadFilePS f = runTM $ runDefaultIO $ mReadFilePS f
     mChangePref a b c = warning $ runDefaultIO $ mChangePref a b c
diff --git a/src/Darcs/Repository/Clone.hs b/src/Darcs/Repository/Clone.hs
index a0ecd51e..6327ee60 100644
--- a/src/Darcs/Repository/Clone.hs
+++ b/src/Darcs/Repository/Clone.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Darcs.Repository.Clone
     ( cloneRepository
     ) where
@@ -5,8 +6,7 @@ module Darcs.Repository.Clone
 import Darcs.Prelude
 
 import Control.Exception ( catch, SomeException )
-import Control.Monad ( forM, unless, void, when )
-import qualified Data.ByteString.Char8 as BC
+import Control.Monad ( unless, void, when )
 import Data.List( intercalate )
 import Data.Maybe( catMaybes )
 import Safe ( tailErr )
@@ -46,7 +46,6 @@ import Darcs.Repository.InternalTypes
     , repoCache
     , modifyCache
     )
-import Darcs.Repository.Job ( withUMaskFlag )
 import Darcs.Util.Cache
     ( filterRemoteCaches
     , fetchFileUsingCache
@@ -55,23 +54,14 @@ import Darcs.Util.Cache
     )
 
 import Darcs.Repository.ApplyPatches ( runDefault )
-import Darcs.Repository.Inventory
-    ( PatchHash
-    , encodeValidHash
-    , peekPristineHash
-    )
+import Darcs.Repository.Inventory ( PatchHash )
 import Darcs.Repository.Format
     ( RepoProperty ( HashedInventory, Darcs2, Darcs3 )
     , RepoFormat
     , formatHas
     )
 import Darcs.Repository.Prefs ( addRepoSource, deleteSources )
-import Darcs.Repository.Match ( getOnePatchset )
-import Darcs.Util.File
-    ( copyFileOrUrl
-    , Cachable(..)
-    , gzFetchFilePS
-    )
+import Darcs.Util.File ( Cachable(..), copyFileOrUrl )
 import Darcs.Repository.PatchIndex
     ( doesPatchIndexExist
     , createPIWithInterrupt
@@ -79,7 +69,6 @@ import Darcs.Repository.PatchIndex
 import Darcs.Repository.Packs
     ( fetchAndUnpackBasic
     , fetchAndUnpackPatches
-    , packsDir
     )
 import Darcs.Repository.Paths ( hashedInventoryPath, pristineDirPath )
 import Darcs.Repository.Resolution
@@ -88,7 +77,7 @@ import Darcs.Repository.Resolution
     , announceConflicts
     )
 import Darcs.Repository.Working ( applyToWorking )
-import Darcs.Util.Lock ( writeTextFile, withNewDirectory )
+import Darcs.Util.Lock ( writeTextFile )
 import Darcs.Repository.Flags
     ( UpdatePending(..)
     , UseCache(..)
@@ -97,7 +86,6 @@ import Darcs.Repository.Flags
     , CloneKind (..)
     , Verbosity (..)
     , DryRun (..)
-    , UMask (..)
     , SetScriptsExecutable (..)
     , SetDefault (..)
     , InheritDefault (..)
@@ -117,13 +105,12 @@ import Darcs.Patch.Set
     ( Origin
     , patchSet2FL
     , patchSet2RL
-    , patchSetInventoryHashes
     , progressPatchSet
     )
-import Darcs.Patch.Match ( MatchFlag(..), patchSetMatch )
+import Darcs.Patch.Match ( MatchFlag(..), patchSetMatch, matchOnePatchset )
 import Darcs.Patch.Progress ( progressRLShowTags, progressFL )
 import Darcs.Patch.Apply ( Apply(..) )
-import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
+import Darcs.Patch.Witnesses.Sealed ( Sealed(..), Sealed2(..) )
 import Darcs.Patch.Witnesses.Ordered
     ( (:\/:)(..)
     , FL(..)
@@ -139,6 +126,7 @@ import Darcs.Util.Tree( Tree )
 
 import Darcs.Util.Exception ( catchall )
 import Darcs.Util.English ( englishNum, Noun(..) )
+import Darcs.Util.File ( removeFileMayNotExist )
 import Darcs.Util.Global ( darcsdir )
 import Darcs.Util.URL ( isValidLocalPath )
 import Darcs.Util.SignalHandler ( catchInterrupt, withSignalsBlocked )
@@ -155,27 +143,26 @@ import Darcs.Util.Progress
 joinUrl :: [String] -> String
 joinUrl = intercalate "/"
 
-cloneRepository ::
-    String    -- origin repository path
-    -> String -- new repository name (for relative path)
-    -> Verbosity -> UseCache
+cloneRepository
+    :: String    -- origin repository path
+    -> Verbosity
+    -> UseCache
     -> CloneKind
-    -> UMask -> RemoteDarcs
+    -> RemoteDarcs
     -> SetScriptsExecutable
     -> SetDefault
     -> InheritDefault
     -> [MatchFlag]
     -> RepoFormat
     -> WithWorkingDir
-    -> WithPatchIndex   -- use patch index
+    -> WithPatchIndex
     -> Bool   -- use packs
     -> ForgetParent
     -> WithPrefsTemplates
     -> IO ()
-cloneRepository repourl mysimplename v useCache cloneKind um rdarcs sse
+cloneRepository repourl v useCache cloneKind rdarcs sse
                 setDefault inheritDefault matchFlags rfsource withWorkingDir
-                usePatchIndex usePacks forget withPrefsTemplates =
-  withUMaskFlag um $ withNewDirectory mysimplename $ do
+                usePatchIndex usePacks forget withPrefsTemplates = do
       let patchfmt
             | formatHas Darcs3 rfsource = PatchFormat3
             | formatHas Darcs2 rfsource = PatchFormat2
@@ -188,7 +175,7 @@ cloneRepository repourl mysimplename v useCache cloneKind um rdarcs sse
       addRepoSource repourl NoDryRun setDefault inheritDefault False
 
       debugMessage "Identifying remote repository..."
-      fromRepo <- identifyRepositoryFor Reading _toRepo useCache repourl
+      Sealed2 fromRepo <- identifyRepositoryFor Reading _toRepo useCache repourl
       let fromLoc = repoLocation fromRepo
 
       debugMessage "Copying prefs..."
@@ -211,7 +198,7 @@ cloneRepository repourl mysimplename v useCache cloneKind um rdarcs sse
          else copyBasicRepoNotPacked fromRepo _toRepo v rdarcs withWorkingDir
        when (cloneKind /= LazyClone) $ do
          when (cloneKind /= CompleteClone) $
-           putInfo v $ text "Copying patches, to get lazy repository hit ctrl-C..."
+           putInfo v "Copying patches, to get lazy repository hit ctrl-C..."
          debugMessage "Copying complete repository (inventories and patches)"
          if usePacks && (not . isValidLocalPath) fromLoc
            then copyCompleteRepoPacked    fromRepo _toRepo v cloneKind
@@ -224,11 +211,11 @@ cloneRepository repourl mysimplename v useCache cloneKind um rdarcs sse
       case patchSetMatch matchFlags of
        Nothing -> return ()
        Just psm -> do
-        putInfo v $ text "Going to specified version..."
+        putInfo v "Going to specified version..."
         -- the following is necessary to be able to read _toRepo's patches
         _toRepo <- revertRepositoryChanges _toRepo
         patches <- readPatches _toRepo
-        Sealed context <- getOnePatchset _toRepo psm
+        Sealed context <- matchOnePatchset patches psm
         to_remove :\/: only_in_context <- return $ findUncommon patches context
         case only_in_context of
           NilFL -> do
@@ -248,10 +235,14 @@ cloneRepository repourl mysimplename v useCache cloneKind um rdarcs sse
             -- This can only happen if the user supplied a context file that
             -- doesn't specify a subset of the remote repo.
             fail $ unsafeRenderStringColored
-              $ text "Missing patches from context:"
+              $ "Missing patches from context:"
               $$ description only_in_context
       when (forget == YesForgetParent) deleteSources
-      -- check for unresolved conflicts
+      -- TODO Checking for unresolved conflicts means we have to download
+      -- at least all the patches referenced by hashed_inventory, even if
+      -- --lazy is in effect. This can take a long time, and in extreme
+      -- cases can even result in --lazy being slower than --complete.
+      putVerbose v $ text "Checking for unresolved conflicts..."
       patches <- readPatches _toRepo
       let conflicts = patchsetConflictResolutions patches
       _ <- announceConflicts "clone" (YesAllowConflicts MarkConflicts) conflicts
@@ -269,113 +260,79 @@ putVerbose _ _ = return ()
 
 copyBasicRepoNotPacked  :: forall p wU wR.
                            Repository 'RO p wU wR -- remote
-                        -> Repository 'RO p wU wR -- existing empty local
+                        -> Repository 'RO p Origin Origin -- empty local
                         -> Verbosity
                         -> RemoteDarcs
                         -> WithWorkingDir
                         -> IO ()
 copyBasicRepoNotPacked fromRepo toRepo verb rdarcs withWorkingDir = do
-  putVerbose verb $ text "Copying hashed inventory from remote repo..."
+  putVerbose verb "Copying hashed inventory from remote repo..."
   copyHashedInventory toRepo rdarcs (repoLocation fromRepo)
-  putVerbose verb $ text "Writing pristine and working tree contents..."
+  putVerbose verb "Writing pristine and working tree contents..."
   createPristineDirectoryTree toRepo "." withWorkingDir
 
-copyCompleteRepoNotPacked :: forall rt p wU wR. (RepoPatch p, ApplyState p ~ Tree)
-                        => Repository 'RO p wU wR -- remote
-                        -> Repository rt p wU wR -- existing basic local
-                        -> Verbosity
-                        -> CloneKind
-                        -> IO ()
-copyCompleteRepoNotPacked _ toRepo verb cloneKind = do
-       let cleanup = putInfo verb $ text "Using lazy repository."
-       allowCtrlC cloneKind cleanup $ do
-         fetchPatchesIfNecessary toRepo
-         pi <- doesPatchIndexExist (repoLocation toRepo)
-         ps <- readPatches toRepo
-         when pi $ createPIWithInterrupt toRepo ps
-
-copyBasicRepoPacked ::
-  forall p wU wR.
-     Repository 'RO p wU wR -- remote
-  -> Repository 'RO p wU wR -- existing empty local repository
+copyCompleteRepoNotPacked
+  :: forall rt p wU wR vU vR
+   . (RepoPatch p, ApplyState p ~ Tree)
+  => Repository 'RO p wU wR -- remote
+  -> Repository rt p vU vR  -- basic local
   -> Verbosity
-  -> RemoteDarcs
-  -> WithWorkingDir
+  -> CloneKind
   -> IO ()
-copyBasicRepoPacked fromRepo toRepo verb rdarcs withWorkingDir =
-  do let fromLoc = repoLocation fromRepo
-     let hashURL = joinUrl [fromLoc, darcsdir, packsDir, "pristine"]
-     mPackHash <- (Just <$> gzFetchFilePS hashURL Uncachable) `catchall` (return Nothing)
-     let hiURL = fromLoc </> hashedInventoryPath
-     i <- gzFetchFilePS hiURL Uncachable
-     let currentHash = BC.pack $ encodeValidHash $ peekPristineHash i
-     let copyNormally = copyBasicRepoNotPacked fromRepo toRepo verb rdarcs withWorkingDir
-     case mPackHash of
-      Just packHash | packHash == currentHash
-              -> ( do copyBasicRepoPacked2 fromRepo toRepo verb withWorkingDir
-                      -- need to obtain a fresh copy of hashed_inventory as reference
-                      putVerbose verb $ text "Copying hashed inventory from remote repo..."
-                      copyHashedInventory toRepo rdarcs (repoLocation fromRepo)
-                   `catch` \(e :: SomeException) ->
-                               do putStrLn ("Exception while getting basic pack:\n" ++ show e)
-                                  copyNormally)
-      _       -> do putVerbose verb $
-                      text "Remote repo has no basic pack or outdated basic pack, copying normally."
-                    copyNormally
+copyCompleteRepoNotPacked _ toRepo verb cloneKind = do
+  let cleanup = putInfo verb "Using lazy repository."
+  allowCtrlC cloneKind cleanup $ do
+    fetchPatchesIfNecessary toRepo
+    pi <- doesPatchIndexExist (repoLocation toRepo)
+    ps <- readPatches toRepo
+    when pi $ createPIWithInterrupt toRepo ps
 
-copyBasicRepoPacked2 ::
-  forall rt p wU wR.
-     Repository 'RO p wU wR -- remote
-  -> Repository rt p wU wR -- existing empty local repository
+copyBasicRepoPacked
+  :: forall p wU wR
+   . Repository 'RO p wU wR -- remote
+  -> Repository 'RO p Origin Origin -- empty local
   -> Verbosity
+  -> RemoteDarcs
   -> WithWorkingDir
   -> IO ()
-copyBasicRepoPacked2 fromRepo toRepo verb withWorkingDir = do
-  putVerbose verb $ text "Cloning packed basic repository."
-  -- unpack inventory & pristine cache
+copyBasicRepoPacked fromRepo toRepo verb rdarcs withWorkingDir = do
+  putVerbose verb "Trying to clone packed basic repository."
   cleanDir pristineDirPath
-  removeFile hashedInventoryPath
-  fetchAndUnpackBasic (repoCache toRepo) (repoLocation fromRepo)
-  putInfo verb $ text "Done fetching and unpacking basic pack."
-  createPristineDirectoryTree toRepo "." withWorkingDir
+  removeFileMayNotExist hashedInventoryPath
+  do
+    fetchAndUnpackBasic (repoCache toRepo) (repoLocation fromRepo)
+    putInfo verb "Done fetching and unpacking basic pack."
+   `catch` \(_ :: SomeException) -> do
+      putVerbose verb
+        "Remote repo has no basic pack, copying normally."
+  -- Calling copyBasicRepoNotPacked here will overwrite hashed_inventory
+  -- in case the basic pack was outdated. It then proceeds with a call
+  -- to createPristineDirectoryTree which will download any missing
+  -- pristine files.
+  copyBasicRepoNotPacked fromRepo toRepo verb rdarcs withWorkingDir
 
-copyCompleteRepoPacked ::
-  forall rt p wU wR. (RepoPatch p, ApplyState p ~ Tree)
+copyCompleteRepoPacked
+  :: forall rt p wU wR vU vR
+   . (RepoPatch p, ApplyState p ~ Tree)
   => Repository 'RO p wU wR -- remote
-  -> Repository rt p wU wR -- existing basic local repository
+  -> Repository rt p vU vR  -- basic local
   -> Verbosity
   -> CloneKind
   -> IO ()
-copyCompleteRepoPacked from to verb cloneKind =
-    copyCompleteRepoPacked2 from to verb cloneKind
+copyCompleteRepoPacked fromRepo toRepo verb cloneKind = do
+    us <- readPatches toRepo
+    -- get old patches
+    let cleanup = putInfo verb "Using lazy repository."
+    allowCtrlC cloneKind cleanup $ do
+      putInfo verb "Downloading inventories and patches, using patches pack..."
+      fetchAndUnpackPatches us (repoCache toRepo) (repoLocation fromRepo)
+      pi <- doesPatchIndexExist (repoLocation toRepo)
+      when pi $ createPIWithInterrupt toRepo us -- TODO or do another readPatches?
   `catch`
     \(e :: SomeException) -> do
       putStrLn ("Exception while getting patches pack:\n" ++ show e)
-      putVerbose verb $ text "Problem while copying patches pack, copying normally."
-      copyCompleteRepoNotPacked from to verb cloneKind
-
-copyCompleteRepoPacked2 ::
-  forall rt p wU wR. (RepoPatch p, ApplyState p ~ Tree)
-  => Repository 'RO p wU wR
-  -> Repository rt p wU wR
-  -> Verbosity
-  -> CloneKind
-  -> IO ()
-copyCompleteRepoPacked2 fromRepo toRepo verb cloneKind = do
-  us <- readPatches toRepo
-  -- get old patches
-  let cleanup = putInfo verb $ text "Using lazy repository."
-  allowCtrlC cloneKind cleanup $ do
-    putVerbose verb $ text "Using patches pack."
-    is <-
-      forM (patchSetInventoryHashes us) $
-        maybe (fail "unexpected unhashed inventory") return
-    hs <-
-      forM (mapRL hashedPatchHash $ patchSet2RL us) $
-        maybe (fail "unexpected unhashed patch") return
-    fetchAndUnpackPatches is hs (repoCache toRepo) (repoLocation fromRepo)
-    pi <- doesPatchIndexExist (repoLocation toRepo)
-    when pi $ createPIWithInterrupt toRepo us -- TODO or do another readPatches?
+      putVerbose verb "Problem while copying patches pack, copying normally."
+      copyCompleteRepoNotPacked fromRepo toRepo verb cloneKind
 
 cleanDir :: FilePath -> IO ()
 cleanDir d = mapM_ (\x -> removeFile $ d </> x) =<< listDirectory d
@@ -399,7 +356,7 @@ copyRepoOldFashioned fromRepo _toRepo verb withWorkingDir = do
   let patchesToApply = progressFL "Applying patch" $ patchSet2FL local_patches
   applyToTentativePristine _toRepo (mkInvertible patchesToApply)
   _toRepo <- finalizeRepositoryChanges _toRepo NoDryRun
-  putVerbose verb $ text "Writing the working tree..."
+  putVerbose verb "Writing the working tree..."
   createPristineDirectoryTree _toRepo "." withWorkingDir
 
 -- | This function fetches all patches that the given repository has
diff --git a/src/Darcs/Repository/Create.hs b/src/Darcs/Repository/Create.hs
index 9c6e7661..68630681 100644
--- a/src/Darcs/Repository/Create.hs
+++ b/src/Darcs/Repository/Create.hs
@@ -52,7 +52,6 @@ import Darcs.Repository.Paths
 import Darcs.Repository.Identify ( seekRepo )
 import Darcs.Repository.InternalTypes
     ( AccessType(..)
-    , PristineType(..)
     , Repository
     , mkRepo
     )
@@ -115,21 +114,21 @@ mkRepoV1
   -> RepoFormat
   -> Cache
   -> Repository 'RO (RepoPatchV1 V1.Prim) Origin Origin
-mkRepoV1 rdir repofmt cache = mkRepo rdir repofmt HashedPristine cache
+mkRepoV1 rdir repofmt cache = mkRepo rdir repofmt cache
 
 mkRepoV2
   :: AbsoluteOrRemotePath
   -> RepoFormat
   -> Cache
   -> Repository 'RO (RepoPatchV2 V2.Prim) Origin Origin
-mkRepoV2 rdir repofmt cache = mkRepo rdir repofmt HashedPristine cache
+mkRepoV2 rdir repofmt cache = mkRepo rdir repofmt cache
 
 mkRepoV3
   :: AbsoluteOrRemotePath
   -> RepoFormat
   -> Cache
   -> Repository 'RO (RepoPatchV3 V2.Prim) Origin Origin
-mkRepoV3 rdir repofmt cache = mkRepo rdir repofmt HashedPristine cache
+mkRepoV3 rdir repofmt cache = mkRepo rdir repofmt cache
 
 createRepositoryV1
   :: WithWorkingDir -> WithPatchIndex -> UseCache -> WithPrefsTemplates
diff --git a/src/Darcs/Repository/Diff.hs b/src/Darcs/Repository/Diff.hs
index 3d888e97..f696607a 100644
--- a/src/Darcs/Repository/Diff.hs
+++ b/src/Darcs/Repository/Diff.hs
@@ -29,8 +29,7 @@
 -- Portability : portable
 
 module Darcs.Repository.Diff
-    (
-      treeDiff
+    ( treeDiff
     ) where
 
 import Darcs.Prelude
@@ -65,22 +64,8 @@ import Darcs.Patch  ( PrimPatch
 import Darcs.Repository.Prefs ( FileType(..) )
 import Darcs.Patch.Witnesses.Ordered ( FL(..), (+>+), concatGapsFL, consGapFL )
 import Darcs.Patch.Witnesses.Sealed ( Gap(..) )
-import Darcs.Repository.Flags ( DiffAlgorithm(..) )
-
-data Diff m = Added (TreeItem m)
-            | Removed (TreeItem m)
-            | Changed (TreeItem m) (TreeItem m)
-
-
-getDiff :: AnchoredPath
-        -> Maybe (TreeItem m)
-        -> Maybe (TreeItem m)
-        -> (AnchoredPath, Diff m)
-getDiff p Nothing (Just t) = (p, Added t)
-getDiff p (Just from) (Just to) = (p, Changed from to)
-getDiff p (Just t) Nothing = (p, Removed t)
-getDiff _ Nothing Nothing = error "impossible case" -- zipTrees should never return this
-
+import Darcs.Util.Diff ( DiffAlgorithm(..) )
+import Darcs.Util.Tree.Diff ( TreeDiff(..), getTreeDiff, organise )
 
 treeDiff :: forall m w prim . (Monad m, Gap w, PrimPatch prim)
          => DiffAlgorithm
@@ -90,24 +75,10 @@ treeDiff :: forall m w prim . (Monad m, Gap w, PrimPatch prim)
          -> m (w (FL prim))
 treeDiff da ft t1 t2 = do
     (from, to) <- diffTrees t1 t2
-    diffs <- mapM (uncurry diff) $ sortBy organise $ zipTrees getDiff from to
+    diffs <- mapM (uncurry diff) $ sortBy organise $ zipTrees getTreeDiff from to
     return $ concatGapsFL diffs
   where
-    -- sort into removes, changes, adds, with removes in reverse-path order
-    -- and everything else in forward order
-    organise :: (AnchoredPath, Diff m) -> (AnchoredPath, Diff m) -> Ordering
-
-    organise (p1, Changed _ _ ) (p2, Changed _ _) = compare p1 p2
-    organise (p1, Added _)      (p2, Added _)   = compare p1 p2
-    organise (p1, Removed _)    (p2, Removed _) = compare p2 p1
-
-    organise (_, Removed _) _ = LT
-    organise _ (_, Removed _) = GT
-
-    organise (_, Changed _ _) _ = LT
-    organise _ (_, Changed _ _) = GT
-
-    diff :: AnchoredPath -> Diff m -> m (w (FL prim))
+    diff :: AnchoredPath -> TreeDiff m -> m (w (FL prim))
     diff _ (Changed (SubTree _) (SubTree _)) = return (emptyGap NilFL)
     diff p (Removed (SubTree _)) =
         -- Note: With files we first make the file empty before removing it.
diff --git a/src/Darcs/Repository/Hashed.hs b/src/Darcs/Repository/Hashed.hs
index aaccec94..54a7a695 100644
--- a/src/Darcs/Repository/Hashed.hs
+++ b/src/Darcs/Repository/Hashed.hs
@@ -44,9 +44,8 @@ import System.Directory
     , renameFile
     )
 import System.FilePath.Posix ( (</>) )
-import System.IO.Unsafe ( unsafeInterleaveIO )
 
-import Darcs.Patch ( RepoPatch, effect, invert, invertFL, readPatch )
+import Darcs.Patch ( RepoPatch, effect, invert, invertFL )
 import Darcs.Patch.Apply ( Apply(..) )
 import Darcs.Patch.Depends
     ( cleanLatestTag
@@ -54,18 +53,15 @@ import Darcs.Patch.Depends
     , slightlyOptimizePatchset
     , fullyOptimizePatchSet
     )
-import Darcs.Patch.Format ( PatchListFormat )
-import Darcs.Patch.Info ( displayPatchInfo, makePatchname, piName )
+import Darcs.Patch.Info ( makePatchname )
 import Darcs.Patch.Invertible ( mkInvertible )
 import Darcs.Patch.PatchInfoAnd
     ( PatchInfoAnd
-    , createHashed
     , hopefully
     , info
-    , patchInfoAndPatch
     )
 import Darcs.Patch.Progress ( progressFL )
-import Darcs.Patch.Read ( ReadPatch )
+import Darcs.Patch.Read ( ReadPatches )
 import Darcs.Patch.Rebase.Suspended
     ( addFixupsToSuspended
     , removeFixupsFromSuspended
@@ -102,13 +98,13 @@ import Darcs.Repository.InternalTypes
     , repoFormat
     , repoLocation
     , unsafeCoerceR
-    , withRepoDir
     )
 import Darcs.Repository.Inventory
     ( peekPristineHash
     , pokePristineHash
     , readPatchesFromInventoryFile
-    , showInventoryEntry
+    , readSinglePatch
+    , formatInventoryEntry
     , writeInventory
     , writePatchIfNecessary
     )
@@ -135,12 +131,11 @@ import Darcs.Util.Cache ( Cache, fetchFileUsingCache )
 import Darcs.Util.File ( Cachable(Uncachable), copyFileOrUrl )
 import Darcs.Util.Hash ( SHA1, sha1Xor, sha1zero )
 import Darcs.Util.Lock
-    ( appendDocBinFile
+    ( appendFormatBinFile
     , writeAtomicFilePS
-    , writeDocBinFile
+    , writeFormatBinFile
     )
-import Darcs.Util.Printer ( renderString )
-import Darcs.Util.Progress ( beginTedious, debugMessage, endTedious )
+import Darcs.Util.Global ( debugMessage )
 import Darcs.Util.SignalHandler ( withSignalsBlocked )
 import Darcs.Util.Tree ( Tree )
 
@@ -151,8 +146,10 @@ revertTentativeChanges :: Repository 'RO p wU wR -> IO ()
 revertTentativeChanges repo = do
     copyFile hashedInventoryPath tentativeHashedInventoryPath
     inv <- gzReadFilePS tentativeHashedInventoryPath
-    pristineHash <- convertSizePrefixedPristine (repoCache repo) (peekPristineHash inv)
-    writeDocBinFile tentativePristinePath $ pokePristineHash pristineHash mempty
+    pristineHash <-
+      convertSizePrefixedPristine (repoCache repo) (peekPristineHash inv)
+    writeFormatBinFile tentativePristinePath $
+      pokePristineHash pristineHash mempty
 {-
     -- this is not needed, as we never again access the pristine hash in
     -- tentativeHashedInventoryPath, only that in tentativePristinePath
@@ -176,7 +173,7 @@ finalizeTentativeChanges r = do
     i <- gzReadFilePS tentativeHashedInventoryPath
     p <- gzReadFilePS tentativePristinePath
     -- Write out the "optimised" tentative inventory.
-    writeDocBinFile tentativeHashedInventoryPath $
+    writeFormatBinFile tentativeHashedInventoryPath $
         pokePristineHash (peekPristineHash p) i
     -- Atomically swap.
     renameFile tentativeHashedInventoryPath hashedInventoryPath
@@ -188,10 +185,11 @@ addToTentativeInventory :: RepoPatch p => Cache
                         -> PatchInfoAnd p wX wY -> IO ()
 addToTentativeInventory c p = do
     hash <- snd <$> writePatchIfNecessary c p
-    appendDocBinFile tentativeHashedInventoryPath $ showInventoryEntry (info p, hash)
+    appendFormatBinFile tentativeHashedInventoryPath $
+      formatInventoryEntry (info p, hash)
 
 -- | Read the recorded 'PatchSet' of a hashed 'Repository'.
-readPatchesHashed :: (PatchListFormat p, ReadPatch p) => Repository rt p wU wR
+readPatchesHashed :: ReadPatches p => Repository rt p wU wR
                   -> IO (PatchSet p Origin wR)
 readPatchesHashed repo =
   case repoAccessType repo of
@@ -199,7 +197,7 @@ readPatchesHashed repo =
     SRW -> readPatchesFromInventoryFile tentativeHashedInventoryPath repo
 
 -- | Read the tentative 'PatchSet' of a (hashed) 'Repository'.
-readTentativePatches :: (PatchListFormat p, ReadPatch p)
+readTentativePatches :: ReadPatches p
                      => Repository 'RW p wU wR
                      -> IO (PatchSet p Origin wR)
 readTentativePatches = readPatchesHashed
@@ -221,22 +219,8 @@ writeAndReadPatch :: RepoPatch p => Cache
                   -> PatchInfoAnd p wX wY -> IO (PatchInfoAnd p wX wY)
 writeAndReadPatch c p = do
     (i, h) <- writePatchIfNecessary c p
-    unsafeInterleaveIO $ readp h i
-  where
-    parse i h = do
-        debugMessage $ "Rereading patch file for: " ++ piName i
-        (fn, ps) <- fetchFileUsingCache c h
-        case readPatch ps of
-            Right x -> return x
-            Left e -> fail $ unlines
-                [ "Couldn't parse patch file " ++ fn
-                , "which is"
-                , renderString $ displayPatchInfo i
-                , e
-                ]
-
-    readp h i = do Sealed x <- createHashed h (parse i)
-                   return . patchInfoAndPatch i $ unsafeCoerceP x
+    Sealed x <- readSinglePatch c i h
+    return (unsafeCoerceP x)
 
 -- | Write a 'PatchSet' to the tentative inventory.
 writeTentativeInventory :: RepoPatch p
@@ -247,11 +231,7 @@ writeTentativeInventory repo patchSet = do
     debugMessage "in writeTentativeInventory..."
     createDirectoryIfMissing False inventoriesDirPath
     let cache = repoCache repo
-        tediousName = "Writing inventory"
-    beginTedious tediousName
-    hash <-
-      writeInventory tediousName cache $ slightlyOptimizePatchset patchSet
-    endTedious tediousName
+    hash <- writeInventory cache $ slightlyOptimizePatchset patchSet
     debugMessage "still in writeTentativeInventory..."
     (_filepath, content) <- fetchFileUsingCache cache hash
     writeAtomicFilePS tentativeHashedInventoryPath content
@@ -283,16 +263,15 @@ tentativelyAddPatches_ :: (RepoPatch p, ApplyState p ~ Tree)
 tentativelyAddPatches_ upr r upe ps = do
     let r' = unsafeCoerceR r
     withTentativeRebase r r' (foldlwFL (removeFixupsFromSuspended . hopefully) ps)
-    withRepoDir r $ do
-       sequenceFL_ (addToTentativeInventory (repoCache r)) ps
-       when (upr == UpdatePristine) $ do
-          applyToTentativePristine r $
-            mkInvertible $ progressFL "Applying to pristine" ps
-       when (upe == YesUpdatePending) $ do
-          debugMessage "Updating pending..."
-          Sealed pend <- readTentativePending r
-          writeTentativePending r' $ invertFL (effect ps) +>>+ pend
-       return r'
+    sequenceFL_ (addToTentativeInventory (repoCache r)) ps
+    when (upr == UpdatePristine) $ do
+      applyToTentativePristine r $
+        mkInvertible $ progressFL "Applying to pristine" ps
+    when (upe == YesUpdatePending) $ do
+      debugMessage "Updating pending..."
+      Sealed pend <- readTentativePending r
+      writeTentativePending r' $ invertFL (effect ps) +>>+ pend
+    return r'
 
 tentativelyAddPatch_ :: (RepoPatch p, ApplyState p ~ Tree)
                      => UpdatePristine
@@ -318,20 +297,19 @@ tentativelyRemovePatches_ :: (RepoPatch p, ApplyState p ~ Tree)
                           -> IO (Repository 'RW p wU wX)
 tentativelyRemovePatches_ upr r upe ps
   | formatHas HashedInventory (repoFormat r) = do
-      withRepoDir r $ do
-        ref <- readTentativePatches r
-        unless (upr == DontUpdatePristineNorRevert) $ removeFromUnrevertContext ref ps
-        debugMessage "Removing changes from tentative inventory..."
-        r' <- removeFromTentativeInventory r ps
-        withTentativeRebase r r' (foldrwFL (addFixupsToSuspended . hopefully) ps)
-        when (upr == UpdatePristine) $
-          applyToTentativePristine r $
-            invert $ mkInvertible $ progressFL "Applying inverse to pristine" ps
-        when (upe == YesUpdatePending) $ do
-          debugMessage "Adding changes to pending..."
-          Sealed pend <- readTentativePending r
-          writeTentativePending r' $ effect ps +>+ pend
-        return r'
+      ref <- readTentativePatches r
+      unless (upr == DontUpdatePristineNorRevert) $ removeFromUnrevertContext ref ps
+      debugMessage "Removing changes from tentative inventory..."
+      r' <- removeFromTentativeInventory r ps
+      withTentativeRebase r r' (foldrwFL (addFixupsToSuspended . hopefully) ps)
+      when (upr == UpdatePristine) $
+        applyToTentativePristine r $
+          invert $ mkInvertible $ progressFL "Applying inverse to pristine" ps
+      when (upe == YesUpdatePending) $ do
+        debugMessage "Adding changes to pending..."
+        Sealed pend <- readTentativePending r
+        writeTentativePending r' $ effect ps +>+ pend
+      return r'
   | otherwise = fail Old.oldRepoFailMsg
 
 -- | Attempt to remove an FL of patches from the tentative inventory.
diff --git a/src/Darcs/Repository/Identify.hs b/src/Darcs/Repository/Identify.hs
index 922cdced..df587f32 100644
--- a/src/Darcs/Repository/Identify.hs
+++ b/src/Darcs/Repository/Identify.hs
@@ -33,6 +33,7 @@ import System.IO ( hPutStrLn, stderr )
 import System.IO.Error ( catchIOError )
 import Data.Maybe ( fromMaybe )
 
+import Darcs.Patch.Witnesses.Sealed ( Sealed2(..) )
 import Darcs.Repository.Old ( oldRepoFailMsg )
 import Darcs.Repository.Flags ( UseCache(..), WorkRepo (..) )
 import Darcs.Util.Path
@@ -45,15 +46,10 @@ import Darcs.Util.URL ( isValidLocalPath )
 import Darcs.Util.Workaround
     ( getCurrentDirectory
     )
-import Darcs.Repository.Paths
-    ( hashedInventoryPath
-    , oldCurrentDirPath
-    , oldPristineDirPath
-    )
+import Darcs.Repository.Paths ( hashedInventoryPath )
 import Darcs.Repository.Prefs ( getCaches )
 import Darcs.Repository.InternalTypes
     ( AccessType(..)
-    , PristineType(..)
     , Repository
     , mkRepo
     , repoFormat
@@ -85,9 +81,8 @@ maybeIdentifyRepository useCache "." =
           Right rf ->
               case readProblem rf of
               Just err -> return $ BadRepository err
-              Nothing -> do pris <- identifyPristine
-                            cs <- getCaches useCache Nothing
-                            return $ GoodRepository $ mkRepo here rf pris cs
+              Nothing -> do cs <- getCaches useCache Nothing
+                            return $ GoodRepository $ mkRepo here rf cs
 maybeIdentifyRepository useCache url' =
  do url <- ioAbsoluteOrRemote url'
     repoFormatOrError <- tryIdentifyRepoFormat (toPath url)
@@ -96,18 +91,7 @@ maybeIdentifyRepository useCache url' =
       Right rf -> case readProblem rf of
                   Just err -> return $ BadRepository err
                   Nothing ->  do cs <- getCaches useCache (Just url)
-                                 return $ GoodRepository $ mkRepo url rf NoPristine cs
-
-identifyPristine :: IO PristineType
-identifyPristine =
-    do pristine <- doesDirectoryExist oldPristineDirPath
-       current  <- doesDirectoryExist oldCurrentDirPath
-       hashinv  <- doesFileExist      hashedInventoryPath
-       case (pristine || current, hashinv) of
-           (False, False) -> return NoPristine
-           (True,  False) -> return PlainPristine
-           (False, True ) -> return HashedPristine
-           _ -> fail "Multiple pristine trees."
+                                 return $ GoodRepository $ mkRepo url rf cs
 
 -- | identifyRepository identifies the repo at 'url'. Warning:
 -- you have to know what kind of patches are found in that repo.
@@ -127,7 +111,7 @@ identifyRepositoryFor :: ReadingOrWriting
                       -> Repository rt p wU wR
                       -> UseCache
                       -> String
-                      -> IO (Repository 'RO p vR vU)
+                      -> IO (Sealed2 (Repository 'RO p))
 identifyRepositoryFor what us useCache them_loc = do
   them <- identifyRepository useCache them_loc
   case
@@ -136,7 +120,7 @@ identifyRepositoryFor what us useCache them_loc = do
       Writing -> transferProblem (repoFormat us) (repoFormat them) 
     of
       Just e -> fail $ "Incompatibility with repository " ++ them_loc ++ ":\n" ++ e
-      Nothing -> return them
+      Nothing -> return (Sealed2 them)
 
 amInRepository :: WorkRepo -> IO (Either String ())
 amInRepository (WorkRepoDir d) =
@@ -157,10 +141,10 @@ amInHashedRepository :: WorkRepo -> IO (Either String ())
 amInHashedRepository wd
  = do inrepo <- amInRepository wd
       case inrepo of
-       Right _ -> do pristine <- identifyPristine
-                     case pristine of
-                       HashedPristine -> return (Right ())
-                       _ -> return (Left oldRepoFailMsg)
+       Right _ -> do
+          doesFileExist hashedInventoryPath >>= \case
+            True -> return (Right ())
+            False -> return (Left oldRepoFailMsg)
        left    -> return left
 
 -- | hunt upwards for the darcs repository
diff --git a/src/Darcs/Repository/InternalTypes.hs b/src/Darcs/Repository/InternalTypes.hs
index e47865fc..bb722a7b 100644
--- a/src/Darcs/Repository/InternalTypes.hs
+++ b/src/Darcs/Repository/InternalTypes.hs
@@ -15,7 +15,6 @@
 -- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 module Darcs.Repository.InternalTypes
     ( Repository
-    , PristineType(..)
     , AccessType(..)
     , SAccessType(..)
     , repoAccessType
@@ -24,8 +23,6 @@ module Darcs.Repository.InternalTypes
     , repoFormat
     , modifyRepoFormat
     , repoLocation
-    , withRepoDir
-    , repoPristineType
     , unsafeCoerceRepoType
     , unsafeCoercePatchType
     , unsafeCoerceR
@@ -37,19 +34,12 @@ module Darcs.Repository.InternalTypes
 
 import Darcs.Prelude
 
-import Darcs.Util.Cache ( Cache )
+import Darcs.Util.Cache ( Cache, WritableOrNot(..), setThisRepo )
 import Darcs.Repository.Format ( RepoFormat, unsafeWriteRepoFormat )
 import Darcs.Repository.Paths ( formatPath )
 import Darcs.Util.Path ( AbsoluteOrRemotePath, toPath )
-import System.Directory ( withCurrentDirectory )
 import Unsafe.Coerce ( unsafeCoerce )
 
-data PristineType
-  = NoPristine
-  | PlainPristine
-  | HashedPristine
-    deriving ( Show, Eq )
-
 data AccessType = RO | RW deriving (Eq)
 
 data SAccessType (rt :: AccessType) where
@@ -66,33 +56,31 @@ data SAccessType (rt :: AccessType) where
 --
 --        * the recorded state when outside a transaction, or
 --        * the tentative state when inside a transaction.
-data Repository (rt :: AccessType) (p :: Type -> Type -> Type) wU wR =
-  Repo !String !RepoFormat !PristineType Cache (SAccessType rt)
+--
+-- Note that none of the accessors are exported.
+data Repository (rt :: AccessType) (p :: Type -> Type -> Type) wU wR = Repo
+  { location :: !String
+  , format :: !RepoFormat
+  , cache :: Cache
+  , access :: (SAccessType rt)
+  }
 
 type role Repository nominal nominal nominal nominal
 
 repoLocation :: Repository rt p wU wR -> String
-repoLocation (Repo loc _ _ _ _) = loc
-
--- | Perform an action with the current working directory set to the
--- 'repoLocation'.
-withRepoDir :: Repository rt p wU wR -> IO a -> IO a
-withRepoDir repo = withCurrentDirectory (repoLocation repo)
+repoLocation = location
 
 repoFormat :: Repository rt p wU wR -> RepoFormat
-repoFormat (Repo _ fmt _ _ _) = fmt
-
-repoPristineType :: Repository rt p wU wR -> PristineType
-repoPristineType (Repo _ _ pr _ _) = pr
+repoFormat = format
 
 repoCache :: Repository rt p wU wR -> Cache
-repoCache (Repo _ _ _ c _) = c
+repoCache = cache
 
 modifyCache :: (Cache -> Cache) -> Repository rt p wU wR -> Repository rt p wU wR
-modifyCache g (Repo l f p c a) = Repo l f p (g c) a
+modifyCache g r@(Repo {cache = c}) = r { cache = g c }
 
 repoAccessType :: Repository rt p wU wR -> SAccessType rt
-repoAccessType (Repo _ _ _ _ s) = s
+repoAccessType = access
 
 unsafeCoerceRepoType :: Repository rt p wU wR -> Repository rt' p wU wR
 unsafeCoerceRepoType = unsafeCoerce
@@ -118,19 +106,21 @@ unsafeCoerceU = unsafeCoerce
 -- of access type 'RO. The same holds for other state that is modified in a
 -- transaction, like the pending patch or the rebase state.
 unsafeStartTransaction :: Repository 'RO p wU wR -> Repository 'RW p wU wR
-unsafeStartTransaction (Repo l f p c SRO) = Repo l f p c SRW
+unsafeStartTransaction Repo {access = SRO, ..} =
+  Repo {access = SRW, cache = setThisRepo location Writable cache, ..}
 
 unsafeEndTransaction :: Repository 'RW p wU wR -> Repository 'RO p wU wR
-unsafeEndTransaction (Repo l f p c SRW) = Repo l f p c SRO
+unsafeEndTransaction Repo {access = SRW, ..} =
+  Repo {access = SRO, cache = setThisRepo location NotWritable cache, ..}
 
-mkRepo :: AbsoluteOrRemotePath -> RepoFormat -> PristineType -> Cache -> Repository 'RO p wU wR
-mkRepo p f pr c = Repo (toPath p) f pr c SRO
+mkRepo :: AbsoluteOrRemotePath -> RepoFormat -> Cache -> Repository 'RO p wU wR
+mkRepo p f c = Repo {location = toPath p, format = f, cache = c, access = SRO}
 
 modifyRepoFormat
   :: (RepoFormat -> RepoFormat)
   -> Repository 'RW p wU wR
   -> IO (Repository 'RW p wU wR)
-modifyRepoFormat f (Repo l fmt p c a) = do
+modifyRepoFormat f r@(Repo {format = fmt}) = do
   let fmt' = f fmt
   unsafeWriteRepoFormat fmt' formatPath
-  return $ Repo l fmt' p c a
+  return r {format = fmt'}
diff --git a/src/Darcs/Repository/Inventory.hs b/src/Darcs/Repository/Inventory.hs
index 15d372d2..88f98637 100644
--- a/src/Darcs/Repository/Inventory.hs
+++ b/src/Darcs/Repository/Inventory.hs
@@ -2,11 +2,10 @@ module Darcs.Repository.Inventory
     ( module Darcs.Repository.Inventory.Format
     , readPatchesFromInventoryFile
     , readPatchesFromInventory
-    , readSinglePatch
     , readOneInventory
+    , readSinglePatch
     , writeInventory
     , writePatchIfNecessary
-    , writeHashFile
     ) where
 
 import Darcs.Prelude
@@ -17,20 +16,18 @@ import System.FilePath.Posix ( (</>) )
 import System.IO ( hPutStrLn, stderr )
 import System.IO.Unsafe ( unsafeInterleaveIO )
 
-import Darcs.Patch ( RepoPatch, readPatch, showPatch )
-import Darcs.Patch.Format ( PatchListFormat )
-import Darcs.Patch.Info ( PatchInfo, displayPatchInfo, piName )
+import Darcs.Patch ( RepoPatch, readPatch )
+import Darcs.Patch.Format ( FormatPatch(..) )
+import Darcs.Patch.Info ( PatchInfo, showPatchInfo, piName )
 import Darcs.Patch.PatchInfoAnd
     ( PatchInfoAnd
     , PatchInfoAndG
     , createHashed
     , extractHash
     , info
-    , patchInfoAndPatch
     )
-import Darcs.Patch.Read ( ReadPatch )
+import Darcs.Patch.Read ( ReadPatch, ReadPatches )
 import Darcs.Patch.Set ( Origin, PatchSet(..), SealedPatchSet, Tagged(..) )
-import Darcs.Patch.Show ( ShowPatchFor(..) )
 import Darcs.Patch.Witnesses.Ordered ( RL(..), mapRL )
 import Darcs.Patch.Witnesses.Sealed ( Sealed(..), mapSeal, seal, unseal )
 import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
@@ -44,12 +41,13 @@ import Darcs.Util.Cache
     , writeFileUsingCache
     )
 import Darcs.Util.File ( Cachable(Uncachable), gzFetchFilePS )
-import Darcs.Util.Printer ( Doc, renderPS, renderString, text, ($$) )
-import Darcs.Util.Progress ( debugMessage, finishedOneIO )
+import Darcs.Util.Format ( Format, ascii, toLazyByteString, ($$) )
+import Darcs.Util.Printer ( renderString )
+import Darcs.Util.Progress ( debugMessage, finishedOneIO, withProgress )
 
 -- | Read a 'PatchSet' starting with a specific inventory inside a 'Repository'.
 readPatchesFromInventoryFile
-  :: (PatchListFormat p, ReadPatch p)
+  :: ReadPatches p
   => FilePath
   -> Repository rt p wU wR
   -> IO (PatchSet p Origin wS)
@@ -64,15 +62,17 @@ readPatchesFromInventoryFile invPath repo = do
 
 -- | Read a complete 'PatchSet' from a 'Cache', by following the chain of
 -- 'Inventory's, starting with the given one.
-readPatchesFromInventory :: (PatchListFormat p, ReadPatch p)
+-- Note that we read inventories and patches lazily, explicitly using
+-- 'unsafeInterleaveIO' to delay IO actions until the value is demanded. This
+-- is justified by the fact that inventories and patches are stored in hashed
+-- format, which implies that the files we read are never mutated.
+readPatchesFromInventory :: forall p. ReadPatches p
                          => Cache
                          -> Inventory
                          -> IO (SealedPatchSet p Origin)
 readPatchesFromInventory cache = parseInv
   where
-    parseInv :: (PatchListFormat p, ReadPatch p)
-             => Inventory
-             -> IO (SealedPatchSet p Origin)
+    parseInv :: Inventory -> IO (SealedPatchSet p Origin)
     parseInv (Inventory Nothing ris) =
         mapSeal (PatchSet NilRL) <$> readPatchesFromInventoryEntries cache ris
     parseInv (Inventory (Just h) []) =
@@ -83,7 +83,7 @@ readPatchesFromInventory cache = parseInv
         Sealed ps <- delaySealed (readPatchesFromInventoryEntries cache ris)
         return $ seal $ PatchSet ts ps
 
-    read_ts :: (PatchListFormat p, ReadPatch p) => InventoryEntry
+    read_ts :: InventoryEntry
             -> InventoryHash -> IO (Sealed (RL (Tagged p) Origin))
     read_ts tag0 h0 = do
         contents <- unsafeInterleaveIO $ readTaggedInventory h0
@@ -101,10 +101,8 @@ readPatchesFromInventory cache = parseInv
         Sealed tag00 <- read_tag tag0
         return $ seal $ ts :<: Tagged ps tag00 (Just h0)
 
-    read_tag :: (PatchListFormat p, ReadPatch p) => InventoryEntry
-             -> IO (Sealed (PatchInfoAnd p wX))
-    read_tag (i, h) =
-        mapSeal (patchInfoAndPatch i) <$> createHashed h (readSinglePatch cache i)
+    read_tag :: InventoryEntry -> IO (Sealed (PatchInfoAnd p wX))
+    read_tag (i, h) = readSinglePatch cache i h
 
     readTaggedInventory :: InventoryHash -> IO Inventory
     readTaggedInventory invHash = do
@@ -121,34 +119,28 @@ readPatchesFromInventoryEntries :: ReadPatch np
 readPatchesFromInventoryEntries cache ris = read_patches (reverse ris)
   where
     read_patches [] = return $ seal NilRL
-    read_patches allis@((i1, h1) : is1) =
-        lift2Sealed (\p rest -> rest :<: i1 `patchInfoAndPatch` p) (rp is1)
-                    (createHashed h1 (const $ speculateAndParse h1 allis i1))
+    read_patches allis@((i1, h1):is1) =
+      liftReadRL (rp is1) (speculateAndRead h1 allis i1)
       where
         rp [] = return $ seal NilRL
         rp [(i, h), (il, hl)] =
-            lift2Sealed (\p rest -> rest :<: i `patchInfoAndPatch` p)
-                        (rp [(il, hl)])
-                        (createHashed h
-                            (const $ speculateAndParse h (reverse allis) i))
-        rp ((i, h) : is) =
-            lift2Sealed (\p rest -> rest :<: i `patchInfoAndPatch` p)
-                        (rp is)
-                        (createHashed h (readSinglePatch cache i))
-
-    lift2Sealed :: (forall wY wZ . q wY wZ -> p wX wY -> r wX wZ)
-                -> IO (Sealed (p wX))
-                -> (forall wB . IO (Sealed (q wB)))
-                -> IO (Sealed (r wX))
-    lift2Sealed f iox ioy = do
-        Sealed x <- delaySealed iox
-        Sealed y <- delaySealed ioy
-        return $ seal $ f y x
-
-    speculateAndParse h is i = speculate h is >> readSinglePatch cache i h
+          liftReadRL (rp [(il, hl)]) (speculateAndRead h (reverse allis) i)
+        rp ((i, h):is) = liftReadRL (rp is) (readSinglePatch cache i h)
+
+    liftReadRL
+      :: IO (Sealed (RL p wX))
+      -> (forall wB . IO (Sealed (p wB)))
+      -> IO (Sealed (RL p wX))
+    liftReadRL iops iop = do
+      Sealed ps <- delaySealed iops
+      Sealed p <- delaySealed iop
+      return $ seal $ ps :<: p
+
+    speculateAndRead h is i = speculate h is >> readSinglePatch cache i h
 
     speculate :: PatchHash -> [InventoryEntry] -> IO ()
-    speculate pHash is = do
+    speculate pHash is =
+      unsafeInterleaveIO $ do
         already_got_one <- peekInCache cache pHash
         unless already_got_one $
             speculateFilesUsingCache cache (map snd is)
@@ -162,8 +154,9 @@ delaySealed = fmap (unseal seal) . unsafeInterleaveIO
 -- Fails with an error message if the patch file cannot be parsed.
 readSinglePatch :: ReadPatch p
                 => Cache
-                -> PatchInfo -> PatchHash -> IO (Sealed (p wX))
-readSinglePatch cache i h = do
+                -> PatchInfo -> PatchHash -> IO (Sealed (PatchInfoAndG p wX))
+readSinglePatch cache i h =
+  createHashed i h $ do
     debugMessage $ "Reading patch file for: " ++ piName i
     (fn, ps) <- fetchFileUsingCache cache h
     case readPatch ps of
@@ -171,7 +164,7 @@ readSinglePatch cache i h = do
         Left e -> fail $ unlines
             [ "Couldn't parse file " ++ fn
             , "which is patch"
-            , renderString $ displayPatchInfo i
+            , renderString $ showPatchInfo i
             , e
             ]
 
@@ -190,26 +183,25 @@ readInventoryPrivate path = do
       Right r -> return r
       Left e -> fail $ unlines [unwords ["parse error in file", path],e]
 
-writeInventory :: RepoPatch p => String -> Cache
-               -> PatchSet p Origin wX -> IO InventoryHash
-writeInventory tediousName cache = go
+writeInventory :: RepoPatch p => Cache -> PatchSet p Origin wX -> IO InventoryHash
+writeInventory cache = withProgress "Writing inventory" . go
   where
-    go :: RepoPatch p => PatchSet p Origin wX -> IO InventoryHash
-    go (PatchSet ts ps) = do
+    go :: RepoPatch p => PatchSet p Origin wX -> String -> IO InventoryHash
+    go (PatchSet ts ps) k = do
       entries <- sequence $ mapRL (writePatchIfNecessary cache) ps
-      content <- write_ts ts entries
+      content <- write_ts k ts entries
       writeHashFile cache content
-    write_ts NilRL entries = return $ showInventoryPatches (reverse entries)
-    write_ts (tts :<: Tagged tps t maybeHash) entries = do
+    write_ts _ NilRL entries = return $ formatInventoryPatches (reverse entries)
+    write_ts k (tts :<: Tagged tps t maybeHash) entries = do
       -- if the Tagged has a hash, then we know that it has already been
       -- written; otherwise recurse without the tag
-      parenthash <- maybe (go (PatchSet tts tps)) return maybeHash
+      parenthash <- maybe (go (PatchSet tts tps) k) return maybeHash
       let parenthash_str = encodeValidHash parenthash
-      finishedOneIO tediousName parenthash_str
+      finishedOneIO k parenthash_str
       tag_entry <- writePatchIfNecessary cache t
       return $
-        text ("Starting with inventory:\n" ++ parenthash_str) $$
-        showInventoryPatches (tag_entry : reverse entries)
+        ascii ("Starting with inventory:\n" ++ parenthash_str) $$
+        formatInventoryPatches (tag_entry : reverse entries)
 
 -- | Write a 'PatchInfoAnd' to disk and return an 'InventoryEntry' i.e. the
 -- patch info and hash. However, if we patch already contains a hash, assume it
@@ -220,14 +212,12 @@ writePatchIfNecessary :: RepoPatch p => Cache
 writePatchIfNecessary c hp = infohp `seq`
     case extractHash hp of
         Right h -> return (infohp, h)
-        Left p ->
-          (infohp,) <$>
-            writeHashFile c (showPatch ForStorage p)
+        Left p -> (infohp,) <$> writeHashFile c (formatPatch p)
   where
     infohp = info hp
 
 -- | Wrapper around 'writeFileUsingCache' that takes a 'Doc' instead of a
 -- 'ByteString'.
-writeHashFile :: ValidHash h => Cache -> Doc -> IO h
-writeHashFile c d = writeFileUsingCache c (renderPS d)
+writeHashFile :: ValidHash h => Cache -> Format -> IO h
+writeHashFile c = writeFileUsingCache c . toLazyByteString
 
diff --git a/src/Darcs/Repository/Inventory/Format.hs b/src/Darcs/Repository/Inventory/Format.hs
index e62af2a5..32f4c3a4 100644
--- a/src/Darcs/Repository/Inventory/Format.hs
+++ b/src/Darcs/Repository/Inventory/Format.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
 module Darcs.Repository.Inventory.Format
     ( Inventory(..)
     , HeadInventory
@@ -10,17 +11,17 @@ module Darcs.Repository.Inventory.Format
     , PristineHash
     , inventoryPatchNames
     , parseInventory
+    , parseInventoryParent
     , parseHeadInventory -- not used
-    , showInventory
-    , showInventoryPatches
-    , showInventoryEntry
+    , formatInventory
+    , formatInventoryPatches
+    , formatInventoryEntry
     , emptyInventory
     , pokePristineHash
     , peekPristineHash
     , skipPristineHash
-    , pristineName
     -- properties
-    , prop_inventoryParseShow
+    , prop_inventoryParseFormat
     , prop_peekPokePristineHash
     , prop_skipPokePristineHash
     ) where
@@ -31,13 +32,20 @@ import Control.Applicative ( optional, many )
 
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as BL
 
-import Darcs.Patch.Info ( PatchInfo, showPatchInfo, readPatchInfo )
+import Darcs.Patch.Info ( PatchInfo, readPatchInfo, formatPatchInfo )
+import Darcs.Test.TestOnly
 import Darcs.Util.Parser
     ( Parser, char, parse, string, skipSpace )
-import Darcs.Patch.Show ( ShowPatchFor(..) )
-import Darcs.Util.Printer
-    ( Doc, (<+>), ($$), hcat, text, invisiblePS, packedString, renderPS )
+import Darcs.Util.Format
+    ( Format
+    , byteString
+    , newline
+    , toStrictByteString
+    , ($$)
+    , (<+>)
+    )
 import Darcs.Util.ValidHash
     ( InventoryHash
     , PatchHash
@@ -46,6 +54,7 @@ import Darcs.Util.ValidHash
     , calcValidHash
     , decodeValidHash
     , encodeValidHash
+    , formatValidHash
     , parseValidHash
     )
 
@@ -80,12 +89,16 @@ parseHeadInventory = fmap fst . parse pHeadInv
 parseInventory :: B.ByteString -> Either String Inventory
 parseInventory = fmap fst . parse pInv
 
+-- | Parse only the (optional) parent inventory hash, ignore the patches.
+parseInventoryParent :: B.ByteString -> Either String (Maybe InventoryHash)
+parseInventoryParent = fmap fst . parse pInvParent
+
 pHeadInv :: Parser HeadInventory
 pHeadInv = (,) <$> pPristineHash <*> pInv
 
 pPristineHash :: Parser PristineHash
 pPristineHash = do
-  string pristineName
+  string kwPristine
   skipSpace
   pHash
 
@@ -94,7 +107,7 @@ pInv = Inventory <$> pInvParent <*> pInvPatches
 
 pInvParent :: Parser (Maybe InventoryHash)
 pInvParent = optional $ do
-  string parentName
+  string kwParent
   skipSpace
   pHash
 
@@ -108,42 +121,43 @@ pInvEntry :: Parser InventoryEntry
 pInvEntry = do
   info <- readPatchInfo
   skipSpace
-  string hashName
+  string kwHash
   skipSpace
   hash <- pHash
   return (info, hash)
 
--- * Showing
+-- * Formatting
 
-showInventory :: Inventory -> Doc
-showInventory inv =
-  showParent (inventoryParent inv) <>
-  showInventoryPatches (inventoryPatches inv)
+formatInventory :: Inventory -> Format
+formatInventory inv =
+  formatParent (inventoryParent inv) <>
+  formatInventoryPatches (inventoryPatches inv)
 
-showInventoryPatches :: [InventoryEntry] -> Doc
-showInventoryPatches = hcat . map showInventoryEntry
+formatInventoryPatches :: [InventoryEntry] -> Format
+formatInventoryPatches = mconcat . map formatInventoryEntry
 
-showInventoryEntry :: InventoryEntry -> Doc
-showInventoryEntry (pinf, hash) =
-  showPatchInfo ForStorage pinf $$
-  packedString hashName <+> text (encodeValidHash hash) <> packedString newline
+formatInventoryEntry :: InventoryEntry -> Format
+formatInventoryEntry (pinf, hash) =
+  formatPatchInfo pinf $$
+  byteString kwHash <+> formatValidHash hash <> newline
 
-showParent :: Maybe InventoryHash -> Doc
-showParent (Just hash) =
-  packedString parentName $$ text (encodeValidHash hash) <> packedString newline
-showParent Nothing = mempty
+formatParent :: Maybe InventoryHash -> Format
+formatParent (Just hash) =
+  byteString kwParent $$ formatValidHash hash <> newline
+formatParent Nothing = mempty
 
 -- * Accessing the pristine hash
 
 -- | Replace the pristine hash at the start of a raw, unparsed 'HeadInventory'
 -- or add it if none is present.
-pokePristineHash :: PristineHash -> B.ByteString -> Doc
+pokePristineHash :: PristineHash -> B.ByteString -> Format
 pokePristineHash hash inv =
-  invisiblePS pristineName <> text (encodeValidHash hash) $$ invisiblePS (skipPristineHash inv)
+  byteString kwPristine <> formatValidHash hash <> newline
+    <> byteString (skipPristineHash inv)
 
 takeHash :: B.ByteString -> Maybe (PristineHash, B.ByteString)
 takeHash input = do
-  let (hline,rest) = BC.breakSubstring newline input
+  let (hline,rest) = BC.breakSubstring (BC.pack "\n") input
   ph <- decodeValidHash (BC.unpack hline)
   return (ph, rest)
 
@@ -154,7 +168,7 @@ peekPristineHash inv =
       case takeHash rest of
         Just (h, _) -> h
         Nothing -> error $ "Bad hash in inventory!"
-    Nothing -> calcValidHash B.empty
+    Nothing -> calcValidHash BL.empty
 
 -- |skipPristineHash drops the 'pristine: HASH' prefix line, if present.
 skipPristineHash :: B.ByteString -> B.ByteString
@@ -165,34 +179,31 @@ skipPristineHash ps =
 
 tryDropPristineName :: B.ByteString -> Maybe B.ByteString
 tryDropPristineName input =
-    if prefix == pristineName then Just rest else Nothing
+    if prefix == kwPristine then Just rest else Nothing
   where
-    (prefix, rest) = B.splitAt (B.length pristineName) input
+    (prefix, rest) = B.splitAt (B.length kwPristine) input
 
 -- * Key phrases
 
-pristineName :: B.ByteString
-pristineName = BC.pack "pristine:"
-
-parentName :: B.ByteString
-parentName = BC.pack "Starting with inventory:"
+kwPristine :: B.ByteString
+kwPristine = BC.pack "pristine:"
 
-hashName :: B.ByteString
-hashName = BC.pack "hash:"
+kwParent :: B.ByteString
+kwParent = BC.pack "Starting with inventory:"
 
-newline :: B.ByteString
-newline = BC.pack "\n"
+kwHash :: B.ByteString
+kwHash = BC.pack "hash:"
 
 -- * Properties
 
-prop_inventoryParseShow :: Inventory -> Bool
-prop_inventoryParseShow inv =
-  Right inv == parseInventory (renderPS (showInventory inv))
+prop_inventoryParseFormat :: TestOnly => Inventory -> Bool
+prop_inventoryParseFormat inv =
+  Right inv == parseInventory (toStrictByteString (formatInventory inv))
 
-prop_peekPokePristineHash :: (PristineHash, B.ByteString) -> Bool
+prop_peekPokePristineHash :: TestOnly => (PristineHash, B.ByteString) -> Bool
 prop_peekPokePristineHash (hash, raw) =
-  hash == peekPristineHash (renderPS (pokePristineHash hash raw))
+  hash == peekPristineHash (toStrictByteString (pokePristineHash hash raw))
 
-prop_skipPokePristineHash :: (PristineHash, B.ByteString) -> Bool
+prop_skipPokePristineHash :: TestOnly => (PristineHash, B.ByteString) -> Bool
 prop_skipPokePristineHash (hash, raw) =
-  raw == skipPristineHash (renderPS (pokePristineHash hash raw))
+  raw == skipPristineHash (toStrictByteString (pokePristineHash hash raw))
diff --git a/src/Darcs/Repository/Match.hs b/src/Darcs/Repository/Match.hs
index 25ecda5a..73dfa877 100644
--- a/src/Darcs/Repository/Match.hs
+++ b/src/Darcs/Repository/Match.hs
@@ -16,34 +16,22 @@
 --  Boston, MA 02110-1301, USA.
 
 module Darcs.Repository.Match
-    (
-      getPristineUpToMatch
-    , getOnePatchset
+    ( getPristineUpToMatch
     ) where
 
 import Darcs.Prelude
 
-import Darcs.Patch.Match
-    ( rollbackToPatchSetMatch
-    , PatchSetMatch(..)
-    , getMatchingTag
-    , matchAPatchset
-    )
-
-import Darcs.Patch.Bundle ( readContextFile )
-import Darcs.Patch.Apply( ApplyState )
 import Darcs.Patch ( RepoPatch )
-import Darcs.Patch.Set ( Origin, SealedPatchSet, patchSetDrop )
+import Darcs.Patch.Apply ( ApplyState )
+import Darcs.Patch.Match ( PatchSetMatch, rollbackToPatchSetMatch )
 
-import Darcs.Repository.InternalTypes ( Repository )
 import Darcs.Repository.Hashed ( readPatches )
+import Darcs.Repository.InternalTypes ( Repository )
 import Darcs.Repository.Pristine ( readPristine )
 
 import Darcs.Util.Tree ( Tree )
 import Darcs.Util.Tree.Monad ( virtualTreeIO )
 
-import Darcs.Util.Path ( toFilePath )
-
 -- | Return the pristine tree up to the given 'PatchSetMatch'.
 -- In the typical case where the match is closer to the end of the repo than
 -- its beginning, this is (a lot) more efficient than applying the result of
@@ -56,17 +44,3 @@ getPristineUpToMatch r psm = do
   ps <- readPatches r
   tree <- readPristine r
   snd <$> virtualTreeIO (rollbackToPatchSetMatch psm ps) tree
-
--- | Return the patches up to the given 'PatchSetMatch'.
-getOnePatchset :: RepoPatch p
-               => Repository rt p wU wR
-               -> PatchSetMatch
-               -> IO (SealedPatchSet p Origin)
-getOnePatchset repository pm =
-  case pm of
-    IndexMatch n -> patchSetDrop (n-1) <$> readPatches repository
-    PatchMatch m -> matchAPatchset m <$> readPatches repository
-    TagMatch m -> getMatchingTag m <$> readPatches repository
-    ContextMatch path -> do
-      ref <- readPatches repository
-      readContextFile ref (toFilePath path)
diff --git a/src/Darcs/Repository/Merge.hs b/src/Darcs/Repository/Merge.hs
index a9f7e166..fcc07517 100644
--- a/src/Darcs/Repository/Merge.hs
+++ b/src/Darcs/Repository/Merge.hs
@@ -21,6 +21,7 @@
 module Darcs.Repository.Merge
     ( tentativelyMergePatches
     , considerMergeToWorking
+    , oldTentativelyMergePatches -- exported for darcsden
     ) where
 
 import Darcs.Prelude
@@ -48,7 +49,7 @@ import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, n2pia, hopefully )
 import Darcs.Patch.Progress( progressFL, progressRL )
 import Darcs.Patch.Set ( PatchSet, Origin, appendPSFL, patchSet2RL )
 import Darcs.Patch.Witnesses.Ordered
-    ( FL(..), RL(..), Fork(..), (:\/:)(..), (:/\:)(..), (+>+), (+<<+)
+    ( FL(..), RL(..), Fork(..), (:>)(..), (:\/:)(..), (:/\:)(..), (+>+), (+<<+)
     , lengthFL, mapFL_FL, concatFL, reverseFL )
 import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed), seal )
 
@@ -132,8 +133,9 @@ state after we finalize our changes.
 
 But we're not done yet: we must also adapt the pending patch and the working
 tree. Note that changing the working tree is not done in this procedure, we
-merely return a list of prims to apply to working. Let us add the difference
-between pristine and working, which we call pw, to the picture.
+merely calculate what is needed to adapt the working tree and return that.
+Let us add the difference between pristine and working, which we call pw, to
+the picture.
 
      T       U
     / \     /
@@ -215,12 +217,18 @@ To see if this is the case we check whether pw' has conflicts. As an extra
 precaution we backup any conflicted files, so the user can refer to them to
 restore things or compare in a diff viewer.
 
-The patches we return are what we need to update U to U'' i.e. them''+>+res.
 The new pending patch starts out at the new tentative state, so as explained
 above, we set it to pw'+>+res, and again rely on sifting to commute out and
 drop anything we don't need.
 
-TODO: We should return a properly coerced @Repository 'RW p wU wR@.
+The information we return should contain what is needed to update U to U''.
+We could return them''+>+res and let the calling code apply that to the
+working tree. In earlier versions we did just that, however, this is very
+inefficient if them'' happens to be a long list of patches. Note that we
+already did the work of applying all of them'' to the pristine tree. So
+instead, we return just pw'+>+res and expect the calling code to overwrite
+the working tree with the the new pristine and then apply the returned list.
+
 -}
 
 tentativelyMergePatches_ :: (RepoPatch p, ApplyState p ~ Tree)
@@ -233,7 +241,9 @@ tentativelyMergePatches_ :: (RepoPatch p, ApplyState p ~ Tree)
                          -> Fork (PatchSet p)
                                  (FL (PatchInfoAnd p))
                                  (FL (PatchInfoAnd p)) Origin wR wY
-                         -> IO (Sealed (FL (PrimOf p) wU))
+                         -> IO ( Sealed (FL (PrimOf p) wU)
+                               , Sealed ((FL (PrimOf p) :> FL (PrimOf p)) wR)
+                               )
 tentativelyMergePatches_ mc _repo cmd allowConflicts wantGuiPause
   reorder diffingOpts@DiffOpts{..} (Fork context us them) = do
     (them' :/\: us') <-
@@ -321,10 +331,28 @@ tentativelyMergePatches_ mc _repo cmd allowConflicts wantGuiPause
                 _repo <- tentativelyAddPatches_ DontUpdatePristine _repo
                           NoUpdatePending them
                 tentativelyAddPatches_ DontUpdatePristine _repo NoUpdatePending us'
-        setTentativePending _repo (effect pw' +>+ resolution)
-    return $ seal (effect them''content +>+ resolution)
+        -- reolutions are currently restricted to hunks so they will
+        -- be sifted out anyway
+        setTentativePending _repo (effect pw' {- +>+ resolution -})
+    return
+      ( seal (effect them''content +>+ resolution)
+      , seal (effect them' :> effect pw' +>+ resolution)
+      )
 
 tentativelyMergePatches :: (RepoPatch p, ApplyState p ~ Tree)
+                        => Repository 'RW p wU wR -> String
+                        -> AllowConflicts
+                        -> WantGuiPause
+                        -> Reorder
+                        -> DiffOpts
+                        -> Fork (PatchSet p)
+                                (FL (PatchInfoAnd p))
+                                (FL (PatchInfoAnd p)) Origin wR wY
+                        -> IO (Sealed ((FL (PrimOf p) :> FL (PrimOf p)) wR))
+tentativelyMergePatches r s a w o d f =
+  snd <$> tentativelyMergePatches_ MakeChanges r s a w o d f
+
+oldTentativelyMergePatches :: (RepoPatch p, ApplyState p ~ Tree)
                         => Repository 'RW p wU wR -> String
                         -> AllowConflicts
                         -> WantGuiPause
@@ -334,7 +362,8 @@ tentativelyMergePatches :: (RepoPatch p, ApplyState p ~ Tree)
                                 (FL (PatchInfoAnd p))
                                 (FL (PatchInfoAnd p)) Origin wR wY
                         -> IO (Sealed (FL (PrimOf p) wU))
-tentativelyMergePatches = tentativelyMergePatches_ MakeChanges
+oldTentativelyMergePatches r s a w o d f =
+  fst <$> tentativelyMergePatches_ MakeChanges r s a w o d f
 
 considerMergeToWorking :: (RepoPatch p, ApplyState p ~ Tree)
                        => Repository 'RW p wU wR -> String
@@ -346,4 +375,5 @@ considerMergeToWorking :: (RepoPatch p, ApplyState p ~ Tree)
                                (FL (PatchInfoAnd p))
                                (FL (PatchInfoAnd p)) Origin wR wY
                        -> IO (Sealed (FL (PrimOf p) wU))
-considerMergeToWorking = tentativelyMergePatches_ DontMakeChanges
+considerMergeToWorking r s a w o d f =
+  fst <$> tentativelyMergePatches_ DontMakeChanges r s a w o d f
diff --git a/src/Darcs/Repository/Old.hs b/src/Darcs/Repository/Old.hs
index 844d317a..b8b0389c 100644
--- a/src/Darcs/Repository/Old.hs
+++ b/src/Darcs/Repository/Old.hs
@@ -26,18 +26,17 @@ import Darcs.Util.Path ( ioAbsoluteOrRemote, toPath )
 import System.IO ( hPutStrLn, stderr )
 import System.IO.Unsafe ( unsafeInterleaveIO )
 import System.FilePath.Posix ( (</>) )
-import Darcs.Patch.PatchInfoAnd ( Hopefully, PatchInfoAnd,
-                         patchInfoAndPatch,
-                         actually, unavailable )
+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, piap, unavailable )
 
 import qualified Data.ByteString as B ( ByteString )
 import qualified Data.ByteString.Char8 as BC ( break, pack, unpack )
+import qualified Data.ByteString.Short as BS
 
 import Darcs.Patch ( RepoPatch, Named, readPatch )
 import qualified Darcs.Util.Parser as P ( parse )
 import Darcs.Patch.Witnesses.Ordered ( RL(..) )
-import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed), seal, unseal, mapSeal )
-import Darcs.Patch.Info ( PatchInfo(..), makePatchname, readPatchInfo, displayPatchInfo )
+import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed), seal, unseal )
+import Darcs.Patch.Info ( PatchInfo(..), makePatchname, readPatchInfo, showPatchInfo )
 import Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet, Origin )
 import Darcs.Util.File
     ( gzFetchFilePS
@@ -75,10 +74,10 @@ readRepoPrivate task repo_dir inventory_name = do
           read_ts _ Nothing = do endTedious task
                                  return $ seal NilRL
           read_ts parse (Just tag0) =
-              do debugMessage $ "Looking for inventory for:\n"++ renderString (displayPatchInfo tag0)
+              do debugMessage $ "Looking for inventory for:\n"++ renderString (showPatchInfo tag0)
                  i <- unsafeInterleaveIO $
                       do x <- gzFetchFilePS (repo_dir </> darcsdir </> "inventories" </> makeFilename tag0) Uncachable
-                         finishedOneIO task (renderString (displayPatchInfo tag0))
+                         finishedOneIO task (renderString (showPatchInfo tag0))
                          return x
                  (mt, is) <- readInventory i
                  Sealed ts <- fmap (unseal seal) $ unsafeInterleaveIO $ read_ts parse mt
@@ -86,19 +85,18 @@ readRepoPrivate task repo_dir inventory_name = do
                  Sealed tag00 <-  parse tag0 `catch`
                                   \(e :: IOException) ->
                                         return $ seal $
-                                        patchInfoAndPatch tag0 $ unavailable $ show e
+                                        unavailable tag0 $ show e
                  return $ seal $ ts :<: Tagged ps tag00 Nothing
           parse2 :: RepoPatch p
                  => PatchInfo -> FilePath
                  -> IO (Sealed (PatchInfoAnd p wX))
           parse2 i fn = do ps <- unsafeInterleaveIO $ gzFetchFilePS fn Cachable
-                           return $ patchInfoAndPatch i
-                             `mapSeal` hopefullyNoParseError (toPath fn) (readPatch ps)
-          hopefullyNoParseError :: String -> Either String (Sealed (Named a1dr wX))
-                                -> Sealed (Hopefully (Named a1dr) wX)
-          hopefullyNoParseError _ (Right (Sealed x)) = seal $ actually x
-          hopefullyNoParseError s (Left e) =
-              seal $ unavailable $ unlines ["Couldn't parse file " ++ s, e]
+                           return $ hopefullyNoParseError (toPath fn) i (readPatch ps)
+          hopefullyNoParseError :: FilePath -> PatchInfo -> Either String (Sealed (Named p wX))
+                                -> Sealed (PatchInfoAnd p wX)
+          hopefullyNoParseError _ i (Right (Sealed x)) = seal $ piap i x
+          hopefullyNoParseError f i (Left e) =
+              seal $ unavailable i $ unlines ["Couldn't parse file " ++ f, e]
           read_patches :: RepoPatch p =>
                           (forall wB . PatchInfo -> IO (Sealed (PatchInfoAnd p wB)))
                        -> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd p) wX))
@@ -107,7 +105,7 @@ readRepoPrivate task repo_dir inventory_name = do
               lift2Sealed (flip (:<:))
                           (read_patches parse is)
                           (parse i `catch` \(e :: IOException) ->
-                           return $ seal $ patchInfoAndPatch i $ unavailable $ show e)
+                           return $ seal $ unavailable i $ show e)
           lift2Sealed :: (forall wY wZ . q wY wZ -> pp wY -> r wZ)
                       -> IO (Sealed pp) -> (forall wB . IO (Sealed (q wB))) -> IO (Sealed r)
           lift2Sealed f iox ioy = do Sealed x <- unseal seal `fmap` unsafeInterleaveIO iox
@@ -133,8 +131,8 @@ oldRepoFailMsg = "ERROR: repository upgrade required, try `darcs optimize upgrad
 --    flag.
 makeFilename :: PatchInfo -> String
 makeFilename pi = showIsoDateTime d++"-"++sha1_a++"-"++ (show $ makePatchname pi) ++ ".gz"
-    where d = readUTCDateOldFashioned $ BC.unpack $ _piDate pi
-          sha1_a = take 5 $ show $ sha1PS $ _piAuthor pi
+    where d = readUTCDateOldFashioned $ BC.unpack $ BS.fromShort $ _piDate pi
+          sha1_a = take 5 $ show $ sha1PS $ BS.fromShort $ _piAuthor pi
 
 readPatchInfos :: B.ByteString -> IO [PatchInfo]
 readPatchInfos inv =
diff --git a/src/Darcs/Repository/Packs.hs b/src/Darcs/Repository/Packs.hs
index 59a8f388..46898424 100644
--- a/src/Darcs/Repository/Packs.hs
+++ b/src/Darcs/Repository/Packs.hs
@@ -60,50 +60,71 @@ import Darcs.Util.Cache
     , bucketFolder
     , closestWritableDirectory
     , fetchFileUsingCache
+    , relinkUsingCache
     )
 import Darcs.Util.File ( Cachable(..), fetchFileLazyPS, withTemp )
 import Darcs.Util.Global ( darcsdir )
-import Darcs.Util.Progress ( debugMessage, progressList )
-import Darcs.Util.ValidHash ( InventoryHash, PatchHash, encodeValidHash )
+import Darcs.Util.Progress
+    ( debugMessage
+    , finishedOneIO
+    , progressList
+    , withProgress
+    )
+import Darcs.Util.ValidHash ( encodeValidHash )
 
 import Darcs.Patch ( RepoPatch )
 import Darcs.Patch.PatchInfoAnd ( extractHash )
 import Darcs.Patch.Progress ( progressFL )
-import Darcs.Patch.Witnesses.Ordered ( mapFL )
-import Darcs.Patch.Set ( patchSet2FL )
+import Darcs.Patch.Set
+    ( Origin
+    , PatchSet
+    , patchSet2FL
+    , patchSet2RL
+    , patchSetInventoryHashes
+    )
+import Darcs.Patch.Witnesses.Ordered ( mapFL, mapRL )
 
-import Darcs.Repository.Traverse ( listInventories )
-import Darcs.Repository.InternalTypes ( Repository, AccessType(RW), withRepoDir )
 import Darcs.Repository.Hashed ( readPatches )
+import Darcs.Repository.InternalTypes
+    ( AccessType(RW)
+    , Repository
+    , repoCache
+    )
 import Darcs.Repository.Paths
     ( hashedInventoryPath
-    , inventoriesDirPath
     , patchesDirPath
     , pristineDirPath
     )
 import Darcs.Repository.Pristine ( readHashedPristineRoot )
+import Darcs.Repository.Traverse ( listInventories )
 
 packsDir, basicPack, patchesPack :: String
 packsDir     = "packs"
 basicPack    = "basic.tar.gz"
 patchesPack  = "patches.tar.gz"
 
-fetchAndUnpack :: FilePath
-               -> Cache
-               -> FilePath
-               -> IO ()
+fetchAndUnpack :: FilePath -> Cache -> FilePath -> IO ()
 fetchAndUnpack filename cache remote = do
   unpackTar cache . Tar.read . GZ.decompress =<<
     fetchFileLazyPS (remote </> darcsdir </> packsDir </> filename) Uncachable
 
-fetchAndUnpackPatches :: [InventoryHash] -> [PatchHash] -> Cache -> FilePath -> IO ()
-fetchAndUnpackPatches ihs phs cache remote =
-  -- Patches pack can miss some new patches of the repository.
-  -- So we download pack asynchonously and always do a complete pass
-  -- of individual patch and inventory files.
+fetchAndUnpackPatches :: PatchSet p Origin wR -> Cache -> FilePath -> IO ()
+fetchAndUnpackPatches ps cache remote =
+  -- Patches pack can be outdated and thus miss some new patches of the
+  -- repository. So we download pack asynchonously and always do a complete
+  -- pass of individual patch and inventory files. This is efficient, since for
+  -- files that already exist (because they were unpacked from the pack),
+  -- fetchFileUsingCache completes very quickly.
   withAsync (fetchAndUnpack patchesPack cache remote) $ \_ -> do
-    forM_ ihs (fetchFileUsingCache cache)
-    forM_ phs (fetchFileUsingCache cache)
+    withProgress "Getting inventories" $
+      forM_ (patchSetInventoryHashes ps) .
+        maybe (fail "unexpected unhashed inventory") . fetch
+    withProgress "Getting patches" $
+      forM_ (mapRL hashedPatchHash $ patchSet2RL ps) .
+        maybe (fail "unexpected unhashed patch") . fetch
+  where
+    fetch k h = fetchFileUsingCache cache h >> finishedOneIO k (encodeValidHash h)
+    hashedPatchHash = either (const Nothing) Just . extractHash
 
 fetchAndUnpackBasic :: Cache -> FilePath -> IO ()
 fetchAndUnpackBasic = fetchAndUnpack basicPack
@@ -146,7 +167,6 @@ unpackTar c (Tar.Next e es) = case Tar.entryContent e of
 -- | Create packs from the current recorded version of the repository.
 createPacks :: RepoPatch p => Repository 'RW p wU wR -> IO ()
 createPacks repo =
- withRepoDir repo $
   flip finally (mapM_ removeFileIfExists
   [ darcsdir </> "meta-filelist-inventories"
   , darcsdir </> "meta-filelist-pristine"
@@ -158,16 +178,18 @@ createPacks repo =
   createDirectoryIfMissing False (darcsdir </> packsDir)
   writeFile ( darcsdir </> packsDir </> "pristine" ) $ encodeValidHash hash
   -- pack patchesTar
-  ps <- mapFL hashedPatchFileName . progressFL "Packing patches" . patchSet2FL <$>
-    readPatches repo
-  is <- map (inventoriesDirPath </>) <$> listInventories
+  ps <- progressFL "Reading patches" . patchSet2FL <$> readPatches repo
+  phs <- sequence $ mapFL patchHash ps
+  forM_ phs $ relinkUsingCache (repoCache repo)
+  let pfs = map (patchesDirPath </>) $ map encodeValidHash phs
+  is <- listInventories repo
   writeFile (darcsdir </> "meta-filelist-inventories") . unlines $
     map takeFileName is
   -- Note: tinkering with zlib's compression parameters does not make
   -- any noticeable difference in generated archive size;
   -- switching to bzip2 would provide ~25% gain OTOH.
   BLC.writeFile (patchesTar <.> "part") . GZ.compress . Tar.write =<<
-    mapM fileEntry' ((darcsdir </> "meta-filelist-inventories") : ps ++ reverse is)
+    mapM fileEntry' ((darcsdir </> "meta-filelist-inventories") : pfs ++ reverse is)
   renameFile (patchesTar <.> "part") patchesTar
   -- pack basicTar
   pr <- sortByMTime =<< dirContents pristineDirPath
@@ -188,9 +210,9 @@ createPacks repo =
     tp <- either fail return $ toTarPath False x
     return $ fileEntry tp content
   dirContents dir = map (dir </>) <$> listDirectory dir
-  hashedPatchFileName x = case extractHash x of
-    Left _ -> fail "unexpected unhashed patch"
-    Right h -> patchesDirPath </> encodeValidHash h
+  patchHash x = case extractHash x of
+    Left _ -> fail "Unexpected unhashed patch"
+    Right h -> return h
   sortByMTime xs = map snd . sort <$> mapM (\x -> (\t -> (t, x)) <$>
     getModificationTime x) xs
   removeFileIfExists x = do
diff --git a/src/Darcs/Repository/Paths.hs b/src/Darcs/Repository/Paths.hs
index 952958bd..5f6c0a13 100644
--- a/src/Darcs/Repository/Paths.hs
+++ b/src/Darcs/Repository/Paths.hs
@@ -14,23 +14,22 @@ makeDarcsdirPath name = darcsdir </> name
 lockPath = makeDarcsdirPath "lock"
 
 -- | Location of the prefs directory.
-prefsDir = "prefs"
-prefsDirPath = makeDarcsdirPath prefsDir
+prefsDirPath = makeDarcsdirPath "prefs"
 
 -- | Location of the (one and only) head inventory.
-hashedInventory = "hashed_inventory"
-hashedInventoryPath = makeDarcsdirPath hashedInventory
+hashedInventoryPath = makeDarcsdirPath "hashed_inventory"
 
 -- | Location of the (one and only) tentative head inventory.
-tentativeHashedInventory = "tentative_hashed_inventory"
-tentativeHashedInventoryPath = makeDarcsdirPath tentativeHashedInventory
+tentativeHashedInventoryPath = makeDarcsdirPath "tentative_hashed_inventory"
 
 -- | Location of parent inventories.
 inventoriesDir = hashedDir HashedInventoriesDir
 inventoriesDirPath = makeDarcsdirPath inventoriesDir
 
--- | Location of pristine trees.
+-- | Location of the (one and only) tentative pristine root
 tentativePristinePath = makeDarcsdirPath "tentative_pristine"
+
+-- | Location of pristine trees.
 pristineDir = hashedDir HashedPristineDir
 pristineDirPath = makeDarcsdirPath pristineDir
 
@@ -52,7 +51,6 @@ formatPath = makeDarcsdirPath "format"
 -- | Location of pending files
 pendingPath = patchesDirPath </> "pending"
 tentativePendingPath = patchesDirPath </> "pending.tentative"
-newPendingPath = patchesDirPath </> "pending.new"
 
 -- | Location of unrevert bundle.
 unrevertPath = patchesDirPath </> "unrevert"
diff --git a/src/Darcs/Repository/Pending.hs b/src/Darcs/Repository/Pending.hs
index 291ec64e..5f118505 100644
--- a/src/Darcs/Repository/Pending.hs
+++ b/src/Darcs/Repository/Pending.hs
@@ -21,7 +21,7 @@ module Darcs.Repository.Pending
     , readTentativePending
     , writeTentativePending
     , siftForPending
-    , tentativelyRemoveFromPW
+    , tentativelyRemoveFromPending
     , revertPending
     , finalizePending
     , setTentativePending
@@ -29,11 +29,13 @@ module Darcs.Repository.Pending
 
 import Darcs.Prelude
 
-import Control.Applicative
+import Control.Exception ( throwIO )
 import System.Directory ( copyFile, renameFile )
+import System.IO.Error ( isDoesNotExistError, tryIOError ) 
 
-import Darcs.Patch ( PrimOf, PrimPatch, RepoPatch, commuteFL, readPatch )
+import Darcs.Patch ( PrimOf, PrimPatch, RepoPatch, commuteFL )
 import Darcs.Patch.Commute ( Commute(..) )
+import Darcs.Patch.Format ( FormatPatch(..) )
 import Darcs.Patch.Invert ( invertFL )
 import Darcs.Patch.Permutations ( partitionFL )
 import Darcs.Patch.Prim
@@ -42,8 +44,7 @@ import Darcs.Patch.Prim
     , coalesce
     )
 import Darcs.Patch.Progress ( progressFL )
-import Darcs.Patch.Read ( ReadPatch(..), bracketedFL )
-import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatchFor(ForStorage) )
+import Darcs.Patch.Read ( ReadPatch(..), legacyReadPatchFL' )
 import Darcs.Patch.Witnesses.Maybe ( Maybe2(..) )
 import Darcs.Patch.Witnesses.Ordered
     ( FL(..)
@@ -59,100 +60,75 @@ import Darcs.Repository.InternalTypes
     , Repository
     , SAccessType(..)
     , repoAccessType
-    , unsafeStartTransaction
-    , withRepoDir
     )
 import Darcs.Repository.Paths ( pendingPath, tentativePendingPath )
 
 import Darcs.Util.ByteString ( gzReadFilePS )
-import Darcs.Util.Exception ( catchDoesNotExistError, ifDoesNotExistError )
-import Darcs.Util.Lock ( writeDocBinFile )
-import Darcs.Util.Parser ( Parser )
-import Darcs.Util.Printer ( Doc, text, vcat, ($$) )
-
-
-tentativeSuffix :: String
-tentativeSuffix = ".tentative"
-
--- | Read the contents of pending.
-readPending :: RepoPatch p => Repository rt p wU wR
-            -> IO (Sealed (FL (PrimOf p) wR))
-readPending repo =
-  case repoAccessType repo of
-    SRO -> readPendingFile "" repo
-    SRW -> readPendingFile tentativeSuffix repo
-
--- |Read the contents of tentative pending.
-readTentativePending :: RepoPatch p => Repository 'RW p wU wR
-                     -> IO (Sealed (FL (PrimOf p) wR))
-readTentativePending = readPendingFile tentativeSuffix
-
--- |Read the pending file with the given suffix. CWD should be the repository
--- directory. Unsafe!
-readPendingFile :: ReadPatch prim => String -> Repository rt p wU wR
-                -> IO (Sealed (FL prim wX))
-readPendingFile suffix _ =
-  ifDoesNotExistError (Sealed NilFL) $ do
-    let filepath = pendingPath ++ suffix
-    raw <- gzReadFilePS filepath
-    case readPatch raw of
-      Right p -> return (mapSeal unFLM p)
-      Left e -> fail $ unlines ["Corrupt pending patch: " ++ show filepath, e]
-
--- Wrapper around FL where printed format uses { } except around singletons.
--- Now that the Show behaviour of FL p can be customised (using
--- showFLBehavior (*)), we could instead change the general behaviour of FL Prim;
--- but since the pending code can be kept nicely compartmentalised, it's nicer
--- to do it this way.
--- (*) bf: This function does not exist.
-newtype FLM p wX wY = FLM { unFLM :: FL p wX wY }
-
-instance ReadPatch p => ReadPatch (FLM p) where
-    readPatch' = mapSeal FLM <$> readMaybeBracketedFL readPatch' '{' '}'
-
-instance ShowPatchBasic p => ShowPatchBasic (FLM p) where
-    showPatch f = showMaybeBracketedFL (showPatch f) '{' '}' . unFLM
-
-readMaybeBracketedFL :: (forall wY . Parser (Sealed (p wY))) -> Char -> Char
-                     -> Parser (Sealed (FL p wX))
-readMaybeBracketedFL parser pre post =
-    bracketedFL parser pre post <|> (mapSeal (:>:NilFL) <$> parser)
-
-showMaybeBracketedFL :: (forall wX wY . p wX wY -> Doc) -> Char -> Char
-                     -> FL p wA wB -> Doc
-showMaybeBracketedFL _ pre post NilFL = text [pre] $$ text [post]
-showMaybeBracketedFL printer _ _ (p :>: NilFL) = printer p
-showMaybeBracketedFL printer pre post ps = text [pre] $$
-                                           vcat (mapFL printer ps) $$
-                                           text [post]
+import Darcs.Util.Exception ( catchDoesNotExistError )
+import Darcs.Util.Format ( Format, ascii, newline, vcat, ($$) )
+import Darcs.Util.Lock ( writeFormatBinFile )
+import Darcs.Util.Parser ( Parser, parseAll )
+
+
+-- | Read the contents of  pending (either tentative or regular, depending on
+-- the repo's transaction parameter).
+readPending
+  :: forall rt p wR wU. RepoPatch p => Repository rt p wU wR -> IO (Sealed (FL (PrimOf p) wR))
+readPending repo = do
+  let filepath :: FilePath =
+        case repoAccessType repo of
+          SRO -> pendingPath
+          SRW -> tentativePendingPath
+  -- note: there are (very) old darcs versions that compress pending,
+  -- see tests/oldfashioned.sh
+  tryIOError (gzReadFilePS filepath) >>= \case
+    Left e
+      | isDoesNotExistError e -> return (Sealed NilFL)
+      | otherwise -> throwIO e
+    Right raw ->
+      case parseAll (readPendingPatch @(PrimOf p)) raw of
+        Right p -> return p
+        Left e -> fail $ unlines ["Corrupt pending patch: " ++ show filepath, e]
+
+-- | Read the contents of tentative pending.
+readTentativePending
+  :: RepoPatch p => Repository 'RW p wU wR -> IO (Sealed (FL (PrimOf p) wR))
+readTentativePending = readPending
+
+readPendingPatch :: ReadPatch prim => Parser (Sealed (FL prim wR))
+readPendingPatch = legacyReadPatchFL'
 
 -- |Write the contents of tentative pending.
 writeTentativePending :: RepoPatch p => Repository 'RW p wU wR
                       -> FL (PrimOf p) wR wP -> IO ()
 writeTentativePending _ ps =
-    unseal (writePatch name . FLM) (siftForPending ps)
-  where
-    name = pendingPath ++ tentativeSuffix
+    unseal (writePatch tentativePendingPath) (siftForPending ps)
+
+writePatch :: FormatPatch p => FilePath -> FL p wX wY -> IO ()
+writePatch f ps = writeFormatBinFile f $ formatPendingPatch ps <> newline
 
-writePatch :: ShowPatchBasic p => FilePath -> p wX wY -> IO ()
-writePatch f p = writeDocBinFile f $ showPatch ForStorage p <> text "\n"
+formatPendingPatch :: FormatPatch p => FL p wA wB -> Format
+formatPendingPatch (p :>: NilFL) = formatPatch p
+formatPendingPatch ps = ascii "{" $$ vcat (mapFL formatPatch ps) $$ ascii "}"
 
 -- | Remove as much as possible of the given list of prim patches from the
--- pending patch. It is used by record and amend to update pending.
+-- pending patch. Used by record and amend to update pending.
 --
--- The "as much as possible" is due to --look-for-* options which cause changes
--- that normally must be explicitly done by the user (such as add, move, and
--- replace) to be inferred from the the diff between pristine and working.
--- Also, before we present prims to the user to select for recording, we
--- coalesce prims from pending and working, which is reason we have to use
--- decoalescing.
-tentativelyRemoveFromPW :: forall p wR wO wP wU. RepoPatch p
-                        => Repository 'RW p wU wR
-                        -> FL (PrimOf p) wO wR -- added repo changes
-                        -> FL (PrimOf p) wO wP -- O = old recorded state
-                        -> FL (PrimOf p) wP wU -- P = (old) pending state
-                        -> IO ()
-tentativelyRemoveFromPW r changes pending _working = do
+-- This is a highly non-trivial operation, since --look-for-* options cause
+-- changes that are normally done explicitly by the user (such as add, move,
+-- and replace) to be inferred from the the diff between pristine and working.
+-- Furthermore, all these changes are coalesced before we present them to the
+-- user to select for recording. Finally, the user can record modified hunks
+-- due to hunk splitting. We have to infer from the recorded changes and the
+-- old pending which parts of pending is "contained" in the recorded changes
+-- and which is not. See 'updatePending' for the details of how to do that.
+tentativelyRemoveFromPending
+  :: RepoPatch p
+  => Repository 'RW p wU wR
+  -> FL (PrimOf p) wO wR -- ^ added repo changes
+  -> FL (PrimOf p) wO wP -- ^ O = old recorded state, P = (old) pending state
+  -> IO ()
+tentativelyRemoveFromPending r changes pending = do
   let inverted_changes = invertFL (progressFL "Removing from pending:" changes)
   unseal (writeTentativePending r) (updatePendingRL inverted_changes pending)
 
@@ -212,18 +188,17 @@ finalizePending _ = renameFile tentativePendingPath pendingPath
 
 -- | Copy the pending patch to the tentative pending, or write a new empty
 -- tentative pending if regular pending does not exist.
-revertPending :: RepoPatch p => Repository 'RO p wU wR -> IO ()
-revertPending r =
+revertPending :: forall p wU wR. RepoPatch p => Repository 'RO p wU wR -> IO ()
+revertPending _ =
   copyFile pendingPath tentativePendingPath `catchDoesNotExistError`
-    (readPending r >>= unseal (writeTentativePending (unsafeStartTransaction r)))
+    writePatch tentativePendingPath emptyPending
+  where
+    emptyPending = NilFL :: FL (PrimOf p) wR wR
 
 -- | Overwrites the pending patch with a new one, starting at the tentative state.
-setTentativePending :: forall p wU wR wP. RepoPatch p
-                    => Repository 'RW p wU wR
-                    -> FL (PrimOf p) wR wP
-                    -> IO ()
-setTentativePending repo ps = do
-    withRepoDir repo $ writeTentativePending repo ps
+setTentativePending
+  :: RepoPatch p => Repository 'RW p wU wR -> FL (PrimOf p) wR wP -> IO ()
+setTentativePending repo ps = writeTentativePending repo ps
 
 -- | Simplify the candidate pending patch through a combination of looking
 -- for self-cancellations (sequences of patches followed by their inverses),
diff --git a/src/Darcs/Repository/Pristine.hs b/src/Darcs/Repository/Pristine.hs
index 330017a5..064cfa7c 100644
--- a/src/Darcs/Repository/Pristine.hs
+++ b/src/Darcs/Repository/Pristine.hs
@@ -36,7 +36,6 @@ import Darcs.Repository.InternalTypes
     , repoCache
     , repoFormat
     , repoLocation
-    , withRepoDir
     )
 import Darcs.Repository.Old ( oldRepoFailMsg )
 import Darcs.Repository.Paths
@@ -46,7 +45,8 @@ import Darcs.Repository.Paths
 
 import Darcs.Util.ByteString ( gzReadFilePS )
 import Darcs.Util.Cache ( Cache )
-import Darcs.Util.Lock ( writeDocBinFile )
+import Darcs.Util.File ( fetchFilePS, Cachable(Uncachable) )
+import Darcs.Util.Lock ( readBinFile, writeFormatBinFile )
 import Darcs.Util.Printer ( ($$), renderString, text )
 import Darcs.Util.Tree ( Tree )
 import Darcs.Util.Tree.Hashed
@@ -114,19 +114,16 @@ applyToTentativePristine r p = do
     -- that just contains said hash).
     let tentativePristineHash = peekPristineHash tentativePristine
     newPristineHash <- applyToHashedPristine (repoCache r) tentativePristineHash p
-    writeDocBinFile tentativePristinePath $
+    writeFormatBinFile tentativePristinePath $
         pokePristineHash newPristineHash tentativePristine
 
 readHashedPristineRoot :: Repository rt p wU wR -> IO PristineHash
 readHashedPristineRoot r =
-  withRepoDir r $
+  peekPristineHash <$>
     case repoAccessType r of
-      SRO -> getHash hashedInventoryPath
-      SRW -> getHash tentativePristinePath -- note the asymmetry!
-  where
-    getHash path =
-      peekPristineHash <$>
-        gzReadFilePS path `catch` (\(_ :: IOException) -> fail oldRepoFailMsg)
+      SRO -> fetchFilePS (repoLocation r </> hashedInventoryPath) Uncachable
+      SRW -> readBinFile tentativePristinePath -- note the asymmetry!
+  `catch` (\(_ :: IOException) -> fail oldRepoFailMsg)
 
 -- | Write the pristine tree into a plain directory at the given path.
 createPristineDirectoryTree ::
@@ -148,7 +145,7 @@ readPristine repo
   | formatHas HashedInventory (repoFormat repo) =
     case repoAccessType repo of
       SRO -> do
-        inv <- gzReadFilePS $ repoLocation repo </> hashedInventoryPath
+        inv <- fetchFilePS (repoLocation repo </> hashedInventoryPath) Uncachable
         let root = peekPristineHash inv
         readDarcsHashed (repoCache repo) root
       SRW -> do
@@ -173,5 +170,5 @@ writePristine repo tree =
   where
     putHash root path = do
       content <- gzReadFilePS path
-      writeDocBinFile path $ pokePristineHash root content
+      writeFormatBinFile path $ pokePristineHash root content
       return root
diff --git a/src/Darcs/Repository/Rebase.hs b/src/Darcs/Repository/Rebase.hs
index 18105887..2ed6ad1c 100644
--- a/src/Darcs/Repository/Rebase.hs
+++ b/src/Darcs/Repository/Rebase.hs
@@ -38,13 +38,12 @@ import Darcs.Patch.Rebase.Suspended
     ( Suspended(Items)
     , countToEdit
     , readSuspended
-    , showSuspended
+    , formatSuspended
     , simplifyPushes
     , removeFixupsFromSuspended
     )
 import Darcs.Patch.Rebase.Fixup ( RebaseFixup(..) )
 import Darcs.Patch.RepoPatch ( RepoPatch, PrimOf )
-import Darcs.Patch.Show ( ShowPatchFor(ForStorage) )
 import Darcs.Patch.Witnesses.Ordered
     ( (:>)(..)
     , FL(..)
@@ -76,7 +75,7 @@ import Darcs.Repository.Paths
 import Darcs.Util.Diff ( DiffAlgorithm(MyersDiff) )
 import Darcs.Util.English ( englishNum, Noun(..) )
 import Darcs.Util.Exception ( catchDoesNotExistError )
-import Darcs.Util.Lock ( writeDocBinFile, readBinFile )
+import Darcs.Util.Lock ( writeFormatBinFile, readBinFile )
 import Darcs.Util.Parser ( parse )
 import Darcs.Util.Printer ( text, hsep, vcat )
 import Darcs.Util.Printer.Color ( ePutDocLn )
@@ -212,7 +211,7 @@ writeRebaseFile :: RepoPatch p
                 => FilePath -> Repository rt p wU wR
                 -> Suspended p wR -> IO ()
 writeRebaseFile path r sp =
-  writeDocBinFile (repoLocation r </> path) (showSuspended ForStorage sp)
+  writeFormatBinFile (repoLocation r </> path) (formatSuspended sp)
 
 type PiaW p = PatchInfoAndG (W.WrappedNamed p)
 
diff --git a/src/Darcs/Repository/Repair.hs b/src/Darcs/Repository/Repair.hs
index 8b041532..4305daa8 100644
--- a/src/Darcs/Repository/Repair.hs
+++ b/src/Darcs/Repository/Repair.hs
@@ -28,7 +28,7 @@ import Darcs.Patch.Witnesses.Ordered
 import Darcs.Patch.Witnesses.Sealed ( Sealed(..), unFreeLeft, unseal )
 import Darcs.Patch.Apply( ApplyState )
 import Darcs.Patch.Repair ( Repair(applyAndTryToFix) )
-import Darcs.Patch.Info ( displayPatchInfo, makePatchname )
+import Darcs.Patch.Info ( showPatchInfo, makePatchname )
 import Darcs.Patch.Set ( Origin, PatchSet(..), Tagged(..), patchSet2FL )
 import Darcs.Patch ( RepoPatch, PrimOf, isInconsistent )
 
@@ -60,7 +60,7 @@ import Darcs.Util.Tree( Tree, emptyTree, list, restrict, expand, itemHash, zipTr
 import Darcs.Util.Tree.Monad( TreeIO )
 import Darcs.Util.Tree.Hashed( darcsUpdateHashes, hashedTreeIO )
 import Darcs.Util.Tree.Plain( readPlainTree )
-import Darcs.Util.Index( treeFromIndex )
+import Darcs.Util.Tree.Index( treeFromIndex )
 
 applyAndFixPatchSet
   :: forall rt p wU wR. (RepoPatch p, ApplyState p ~ Tree)
@@ -99,7 +99,7 @@ applyAndFixPatchSet r s = do
         Nothing -> return (p :>: ps', ps_ok)
         Just (e, p') ->
           liftIO $ do
-            putStrLn $ renderString $ (displayPatchInfo $ info p) $$ text e
+            putStrLn $ renderString $ (showPatchInfo $ info p) $$ text e
             -- FIXME While this is okay semantically, it means we can't
             -- run darcs check in a read-only repo
             p'' <-
@@ -137,7 +137,7 @@ replayRepository' dflag cache repo verbosity = do
     Nothing -> return ()
     Just pinf -> do
       putInfo $ text "Error! Duplicate patch name:"
-      putInfo $ displayPatchInfo pinf
+      putInfo $ showPatchInfo pinf
       -- FIXME repair duplicates by re-generating their salt
       fail "Duplicate patches found."
 
diff --git a/src/Darcs/Repository/Resolution.hs b/src/Darcs/Repository/Resolution.hs
index 6e8291b5..eaa8ce6c 100644
--- a/src/Darcs/Repository/Resolution.hs
+++ b/src/Darcs/Repository/Resolution.hs
@@ -86,7 +86,7 @@ import Darcs.Util.Tree.Plain ( writePlainTree, readPlainTree )
 import Darcs.Util.Global ( darcsdir )
 import Darcs.Util.Printer ( Doc, renderString, ($$), text, redText, vcat )
 import Darcs.Util.Printer.Color ( ePutDocLn )
-import Darcs.Patch ( displayPatch )
+import Darcs.Patch ( showPatch )
 
 data StandardResolution prim wX =
   StandardResolution {
@@ -126,9 +126,9 @@ mangleConflicts conflicts =
     Left (Sealed ps, Sealed qs) ->
       error $ renderString
         $ redText "resolutions conflict:"
-        $$ displayPatch ps
+        $$ showPatch ps
         $$ redText "conflicts with"
-        $$ displayPatch qs
+        $$ showPatch qs
   where
     unmangled = map conflictParts $ filter (isNothing . conflictMangled) conflicts
     conflictedPaths =
@@ -154,7 +154,7 @@ showUnmangled mpaths = vcat . map showUnmangledConflict . filter (affected mpath
 
 showUnravelled :: PrimPatch prim => Doc -> Unravelled prim wX -> Doc
 showUnravelled sep =
-  vcat . intersperse sep . map (unseal displayPatch)
+  vcat . intersperse sep . map (unseal showPatch)
 
 announceConflicts :: PrimPatch prim
                   => String
diff --git a/src/Darcs/Repository/State.hs b/src/Darcs/Repository/State.hs
index e4b2123b..a2cab193 100644
--- a/src/Darcs/Repository/State.hs
+++ b/src/Darcs/Repository/State.hs
@@ -108,7 +108,7 @@ import Darcs.Util.Tree( Tree, restrict, FilterTree, expand, emptyTree, overlay,
                       , ItemType(..), itemType, readBlob, modifyTree, findFile, TreeItem(..)
                       , makeBlobBS, expandPath )
 import qualified Darcs.Util.Tree.Plain as PlainTree ( readPlainTree )
-import Darcs.Util.Index
+import Darcs.Util.Tree.Index
     ( Index
     , indexFormatValid
     , openIndex
@@ -116,7 +116,7 @@ import Darcs.Util.Index
     , updateIndexFrom
     )
 import qualified Darcs.Util.Tree as Tree
-import Darcs.Util.Index ( listFileIDs, getFileID )
+import Darcs.Util.Tree.Index ( listFileIDs, getFileID )
 
 #define TEST_INDEX 0
 
@@ -636,7 +636,7 @@ getReplaces YesLookForReplaces diffalg _repo pending working = do
   where
     modifiedTokens :: PrimOf p wX wY -> [(AnchoredPath, B.ByteString, B.ByteString)]
     modifiedTokens p = case isHunk p of
-      Just (FileHunk f _ old new) ->
+      Just (FileHunk _ f _ old new) ->
         map (\(a,b) -> (f, a, b)) (concatMap checkModified $
           filter (\(a,b) -> length a == length b) -- only keep lines with same number of tokens
             $ zip (map breakToTokens old) (map breakToTokens new))
diff --git a/src/Darcs/Repository/Transaction.hs b/src/Darcs/Repository/Transaction.hs
index 76565061..4e4deaa4 100644
--- a/src/Darcs/Repository/Transaction.hs
+++ b/src/Darcs/Repository/Transaction.hs
@@ -16,7 +16,6 @@ import Darcs.Patch ( ApplyState, PatchInfoAnd, RepoPatch )
 import qualified Darcs.Patch.Rebase.Legacy.Wrapped as W
 import Darcs.Patch.Rebase.Suspended ( Suspended(..), showSuspended )
 import Darcs.Patch.Set ( Origin, PatchSet(..), Tagged(..) )
-import Darcs.Patch.Show ( ShowPatchFor(..) )
 import Darcs.Patch.Witnesses.Ordered ( FL(..), RL(..), (:>)(..) )
 import Darcs.Patch.Witnesses.Sealed ( Dup(..), Sealed(..) )
 
@@ -44,7 +43,6 @@ import Darcs.Repository.InternalTypes
     , unsafeCoerceR
     , unsafeEndTransaction
     , unsafeStartTransaction
-    , withRepoDir
     )
 import Darcs.Repository.Inventory ( readOneInventory )
 import qualified Darcs.Repository.Old as Old ( oldRepoFailMsg )
@@ -88,16 +86,15 @@ revertRepositoryChanges :: RepoPatch p
                         => Repository 'RO p wU wR
                         -> IO (Repository 'RW p wU wR)
 revertRepositoryChanges r
-  | formatHas HashedInventory (repoFormat r) =
-      withRepoDir r $ do
-        checkIndexIsWritable
-          `catchIOError` \e -> fail (unlines ["Cannot write index", show e])
-        revertTentativeUnrevert
-        revertPending r
-        revertTentativeChanges r
-        let r' = unsafeCoerceR r
-        revertTentativeRebase r'
-        return $ unsafeStartTransaction r'
+  | formatHas HashedInventory (repoFormat r) = do
+      checkIndexIsWritable
+        `catchIOError` \e -> fail (unlines ["Cannot write index", show e])
+      revertTentativeUnrevert
+      revertPending r
+      revertTentativeChanges r
+      let r' = unsafeCoerceR r
+      revertTentativeRebase r'
+      return $ unsafeStartTransaction r'
   | otherwise = fail Old.oldRepoFailMsg
 
 -- | Atomically copy the tentative state to the recorded state,
@@ -108,26 +105,25 @@ finalizeRepositoryChanges :: (RepoPatch p, ApplyState p ~ Tree)
                           -> DryRun
                           -> IO (Repository 'RO p wU wR)
 finalizeRepositoryChanges r dryrun
-    | formatHas HashedInventory (repoFormat r) =
-        withRepoDir r $ do
-          let r' = unsafeEndTransaction $ unsafeCoerceR r
-          when (dryrun == NoDryRun) $ do
-            debugMessage "Finalizing changes..."
-            withSignalsBlocked $ do
-                updateRebaseFormat r
-                finalizeTentativeRebase
-                finalizeTentativeChanges r
-                finalizePending r
-                finalizeTentativeUnrevert
-            debugMessage "Done finalizing changes..."
-            ps <- readPatches r'
-            pi_exists <- doesPatchIndexExist (repoLocation r')
-            when pi_exists $
-              createOrUpdatePatchIndexDisk r' ps
-              `catchIOError` \e ->
-                hPutStrLn stderr $ "Cannot create or update patch index: "++ show e
-            updateIndex r'
-          return r'
+    | formatHas HashedInventory (repoFormat r) = do
+        let r' = unsafeEndTransaction $ unsafeCoerceR r
+        when (dryrun == NoDryRun) $ do
+          debugMessage "Finalizing changes..."
+          withSignalsBlocked $ do
+              updateRebaseFormat r
+              finalizeTentativeRebase
+              finalizeTentativeChanges r
+              finalizePending r
+              finalizeTentativeUnrevert
+          debugMessage "Done finalizing changes..."
+          ps <- readPatches r'
+          pi_exists <- doesPatchIndexExist (repoLocation r')
+          when pi_exists $
+            createOrUpdatePatchIndexDisk r' ps
+            `catchIOError` \e ->
+              hPutStrLn stderr $ "Cannot create or update patch index: "++ show e
+          updateIndex r'
+        return r'
     | otherwise = fail Old.oldRepoFailMsg
 
 -- | Upgrade a possible old-style rebase in progress to the new style.
@@ -159,7 +155,7 @@ upgradeOldStyleRebase repo = do
             $  "A new-style rebase is already in progress, not overwriting it."
             $$ "This should not have happened! This is the old-style rebase I found"
             $$ "and removed from the repository:"
-            $$ showSuspended ForDisplay r
+            $$ showSuspended r
 
 checkIndexIsWritable :: IO ()
 checkIndexIsWritable = do
diff --git a/src/Darcs/Repository/Traverse.hs b/src/Darcs/Repository/Traverse.hs
index befde75a..22fd4423 100644
--- a/src/Darcs/Repository/Traverse.hs
+++ b/src/Darcs/Repository/Traverse.hs
@@ -2,55 +2,53 @@ module Darcs.Repository.Traverse
     ( cleanRepository
     , cleanPristineDir
     , listInventories
-    , listInventoriesRepoDir
-    , listPatchesLocalBucketed
     , specialPatches
     ) where
 
 import Darcs.Prelude
 
-import Data.Maybe ( fromJust )
-import qualified Data.ByteString.Char8 as BC ( unpack, pack )
-import qualified Data.Set as Set
+import Data.List ( stripPrefix )
+import Data.Maybe ( mapMaybe )
+import qualified Data.Set as S
 
 import System.Directory ( listDirectory, withCurrentDirectory )
-import System.FilePath.Posix( (</>) )
+import System.FilePath.Posix( takeFileName, (</>) )
 
+import Darcs.Repository.InternalTypes
+    ( AccessType(..)
+    , Repository
+    , repoCache
+    , repoLocation
+    )
 import Darcs.Repository.Inventory
     ( Inventory(..)
+    , InventoryHash
     , PristineHash
     , emptyInventory
     , encodeValidHash
     , inventoryPatchNames
     , parseInventory
+    , parseInventoryParent
     , peekPristineHash
     , skipPristineHash
     )
-import Darcs.Repository.InternalTypes
-    ( Repository
-    , AccessType(..)
-    , repoCache
-    , withRepoDir
-    )
 import Darcs.Repository.Paths
-    ( tentativeHashedInventory
-    , tentativePristinePath
-    , inventoriesDir
-    , inventoriesDirPath
+    ( inventoriesDirPath
     , patchesDirPath
     , pristineDirPath
+    , tentativeHashedInventoryPath
+    , tentativePristinePath
     )
-import Darcs.Repository.Prefs ( globalCacheDir )
 
 import Darcs.Util.ByteString ( gzReadFilePS )
 import Darcs.Util.Cache
     ( Cache
-    , HashedDir(HashedPristineDir)
-    , bucketFolder
+    , HashedDir(..)
     , cleanCachesWithHint
+    , fetchFileUsingCache
     )
-import Darcs.Util.Exception ( ifDoesNotExistError )
-import Darcs.Util.Global ( darcsdir, debugMessage )
+import Darcs.Util.Exception ( ifDoesNotExistError, ifIOError )
+import Darcs.Util.Global ( debugMessage )
 import Darcs.Util.Lock ( removeFileMayNotExist )
 import Darcs.Util.Tree.Hashed ( followPristineHashes )
 
@@ -58,50 +56,45 @@ import Darcs.Util.Tree.Hashed ( followPristineHashes )
 cleanRepository :: Repository 'RW p wU wR -> IO ()
 cleanRepository r = cleanPristine r >> cleanInventories r >> cleanPatches r
 
--- | The way patchfiles, inventories, and pristine trees are stored.
--- 'PlainLayout' means all files are in the same directory. 'BucketedLayout'
--- means we create a second level of subdirectories, such that all files whose
--- hash starts with the same two letters are in the same directory.
--- Currently, only the global cache uses 'BucketedLayout' while repositories
--- use the 'PlainLayout'.
-data DirLayout = PlainLayout | BucketedLayout
-
 -- | Remove unreferenced entries in the pristine cache.
 cleanPristine :: Repository 'RW p wU wR -> IO ()
-cleanPristine r = withRepoDir r $ do
+cleanPristine r = do
     debugMessage "Cleaning out the pristine cache..."
     i <- gzReadFilePS tentativePristinePath
     cleanPristineDir (repoCache r) [peekPristineHash i]
 
 cleanPristineDir :: Cache -> [PristineHash] -> IO ()
 cleanPristineDir cache roots = do
-    reachable <- set . map encodeValidHash <$> followPristineHashes cache roots
-    files <- set <$> listDirectory pristineDirPath
-    let to_remove = unset $ files `Set.difference` reachable
+    reachable <- map encodeValidHash <$> followPristineHashes cache roots
+    files <- listDirectory pristineDirPath
+    let to_remove = diffLists files reachable
     withCurrentDirectory pristineDirPath $
       mapM_ removeFileMayNotExist to_remove
     -- and also clean out any global caches
     debugMessage "Cleaning out any global caches..."
     cleanCachesWithHint cache HashedPristineDir to_remove
-  where
-    set = Set.fromList . map BC.pack
-    unset = map BC.unpack . Set.toList
 
--- | Set difference between two lists of hashes.
-diffHashLists :: [String] -> [String] -> [String]
-diffHashLists xs ys = from_set $ (to_set xs) `Set.difference` (to_set ys)
-  where
-    to_set = Set.fromList . map BC.pack
-    from_set = map BC.unpack . Set.toList
+-- | Set difference between two lists.
+diffLists :: Ord a => [a] -> [a] -> [a]
+diffLists xs ys =
+  S.toList $ S.fromList xs `S.difference` S.fromList ys
 
 -- | Remove unreferenced files in the inventories directory.
 cleanInventories :: Repository 'RW p wU wR -> IO ()
-cleanInventories _ = do
-    debugMessage "Cleaning out inventories..."
-    hs <- listInventoriesLocal
-    fs <- ifDoesNotExistError [] $ listDirectory inventoriesDirPath
-    mapM_ (removeFileMayNotExist . (inventoriesDirPath </>))
-        (diffHashLists fs hs)
+cleanInventories repo = do
+  let cache = repoCache repo
+  debugMessage "Cleaning out inventories..."
+  mHash <- inventoryParent <$> readInventoryFile tentativeHashedInventoryPath
+  reachable <-
+    case mHash of
+      Nothing -> return []
+      Just hash -> map takeFileName <$> followInventories (repoCache repo) hash
+  debugMessage $ unlines ("Reachable:":reachable)
+  files <- listDirectory inventoriesDirPath
+  let to_remove = diffLists files reachable
+  withCurrentDirectory inventoriesDirPath $
+    mapM_ (removeFileMayNotExist) to_remove
+  cleanCachesWithHint cache HashedInventoriesDir to_remove
 
 -- FIXME this is ugly, these files should be directly under _darcs
 -- since they are not hashed. And 'unrevert' isn't even a real patch but
@@ -116,110 +109,76 @@ specialPatches = ["unrevert", "pending", "pending.tentative"]
 cleanPatches :: Repository 'RW p wU wR -> IO ()
 cleanPatches _ = do
     debugMessage "Cleaning out patches..."
-    hs <- (specialPatches ++) <$> listPatchesLocal PlainLayout darcsdir darcsdir
+    hs <- (specialPatches ++) <$> listPatchesLocal
     fs <- ifDoesNotExistError [] (listDirectory patchesDirPath)
-    mapM_ (removeFileMayNotExist . (patchesDirPath </>)) (diffHashLists fs hs)
-
--- | Return a list of the inventories hashes.
--- The first argument can be readInventory or readInventoryLocal.
--- The second argument specifies whether the files are expected
--- to be stored in plain or in bucketed format.
--- The third argument is the directory of the parent inventory files.
--- The fourth argument is the directory of the head inventory file.
-listInventoriesWith
-  :: (FilePath -> IO Inventory)
-  -> DirLayout
-  -> String -> String -> IO [String]
-listInventoriesWith readInv dirformat baseDir startDir = do
-    mbStartingWithInv <- getStartingWithHash startDir tentativeHashedInventory
-    followStartingWiths mbStartingWithInv
-  where
-    getStartingWithHash dir file = inventoryParent <$> readInv (dir </> file)
-
-    invDir = baseDir </> inventoriesDir
-    nextDir dir = case dirformat of
-        BucketedLayout -> invDir </> bucketFolder dir
-        PlainLayout -> invDir
-
-    followStartingWiths Nothing = return []
-    followStartingWiths (Just hash) = do
-        let startingWith = encodeValidHash hash
-        mbNextInv <- getStartingWithHash (nextDir startingWith) startingWith
-        (startingWith :) <$> followStartingWiths mbNextInv
-
--- | Return a list of the inventories hashes.
--- This function attempts to retrieve missing inventory files from the cache.
-listInventories :: IO [String]
-listInventories =
-    listInventoriesWith readInventory PlainLayout darcsdir darcsdir
-
--- | Return inventories hashes by following the head inventory.
--- This function does not attempt to retrieve missing inventory files.
-listInventoriesLocal :: IO [String]
-listInventoriesLocal =
-    listInventoriesWith readInventoryLocal PlainLayout darcsdir darcsdir
-
--- | Return a list of the inventories hashes.
--- The argument @repoDir@ is the directory of the repository from which
--- we are going to read the head inventory file.
--- The rest of hashed files are read from the global cache.
-listInventoriesRepoDir :: String -> IO [String]
-listInventoriesRepoDir repoDir = do
-    gCacheDir' <- globalCacheDir
-    let gCacheInvDir = fromJust gCacheDir'
-    listInventoriesWith
-        readInventoryLocal
-        BucketedLayout
-        gCacheInvDir
-        (repoDir </> darcsdir)
+    mapM_ (removeFileMayNotExist . (patchesDirPath </>)) (diffLists fs hs)
+
+-- | Follow the chain of 'InventoryHash'es starting with the given hash. The
+-- path to the corresponding hashed file is returned, along with those of its
+-- parent inventories.
+--
+-- The first parameter of type 'Cache' determines where we search for hashed
+-- files. To restrict the search to the current directory, pass something like
+-- @mkCache [Cache Repo Writable (repoLocation repo]@.
+followInventories :: Cache -> InventoryHash -> IO [FilePath]
+followInventories cache = go where
+  go hash =
+    ifIOError [] $ do
+      (path, mHash) <- readInventoryParent cache hash
+      case mHash of
+        Nothing -> return [path]
+        Just parentHash -> do
+          paths <- go parentHash
+          return (path : paths)
+
+listInventories :: Repository 'RW p wU wR -> IO [FilePath]
+listInventories repo = do
+  mHash <- inventoryParent <$> readInventoryFile tentativeHashedInventoryPath
+  case mHash of
+    Nothing -> return []
+    Just hash ->
+      mapMaybe (stripPrefix (repoLocation repo ++ "/")) <$>
+        followInventories (repoCache repo) hash
 
 -- | Return a list of the patch filenames, extracted from inventory
 -- files, by starting with the head inventory and then following the
 -- chain of parent inventories.
 --
 -- This function does not attempt to download missing inventory files.
---
--- * The first argument specifies whether the files are expected
---   to be stored in plain or in bucketed format.
--- * The second argument is the directory of the parent inventory.
--- * The third argument is the directory of the head inventory.
-listPatchesLocal :: DirLayout -> String -> String -> IO [String]
-listPatchesLocal dirformat baseDir startDir = do
-  inventory <- readInventory (startDir </> tentativeHashedInventory)
+listPatchesLocal :: IO [String]
+listPatchesLocal = do
+  inventory <- readInventoryFile tentativeHashedInventoryPath
   followStartingWiths
     (inventoryParent inventory)
     (inventoryPatchNames inventory)
   where
-    invDir = baseDir </> inventoriesDir
-    nextDir dir =
-      case dirformat of
-        BucketedLayout -> invDir </> bucketFolder dir
-        PlainLayout -> invDir
+    invDir = inventoriesDirPath
     followStartingWiths Nothing patches = return patches
     followStartingWiths (Just hash) patches = do
       let startingWith = encodeValidHash hash
-      inv <- readInventoryLocal (nextDir startingWith </> startingWith)
+      inv <- readInventoryLocal (invDir </> startingWith)
       (patches ++) <$>
         followStartingWiths (inventoryParent inv) (inventoryPatchNames inv)
 
--- |listPatchesLocalBucketed is similar to listPatchesLocal, but
--- it read the inventory directory under @darcsDir@ in bucketed format.
-listPatchesLocalBucketed :: String -> String -> IO [String]
-listPatchesLocalBucketed = listPatchesLocal BucketedLayout
-
 -- | Read the given inventory file if it exist, otherwise return an empty
 -- inventory. Used when we expect that some inventory files may be missing.
 -- Still fails with an error message if file cannot be parsed.
 readInventoryLocal :: FilePath -> IO Inventory
 readInventoryLocal path =
-  ifDoesNotExistError emptyInventory $ readInventory path
+  ifDoesNotExistError emptyInventory $ readInventoryFile path
 
 -- | Read an inventory from a file. Fails with an error message if
 -- file is not there or cannot be parsed.
-readInventory :: FilePath -> IO Inventory
-readInventory path = do
-  -- FIXME we should check the hash (if this is a hashed file)
+readInventoryFile :: FilePath -> IO Inventory
+readInventoryFile path = do
   inv <- skipPristineHash <$> gzReadFilePS path
   case parseInventory inv of
     Right r -> return r
     Left e -> fail $ unlines [unwords ["parse error in file", path], e]
+
+readInventoryParent :: Cache -> InventoryHash -> IO (FilePath, Maybe InventoryHash)
+readInventoryParent cache hash = do
+  (path, content) <- fetchFileUsingCache cache hash
+  case parseInventoryParent content of
+    Right r -> return (path, r)
+    Left e -> fail $ unlines [unwords ["parse error in file", path], e]
diff --git a/src/Darcs/Repository/Unrevert.hs b/src/Darcs/Repository/Unrevert.hs
index cb35c1b3..ae8b3517 100644
--- a/src/Darcs/Repository/Unrevert.hs
+++ b/src/Darcs/Repository/Unrevert.hs
@@ -28,7 +28,7 @@ import Darcs.Repository.Paths ( tentativeUnrevertPath, unrevertPath )
 import Darcs.Util.Exception ( catchDoesNotExistError, ifDoesNotExistError )
 import Darcs.Util.Global ( debugMessage )
 import Darcs.Util.IsoDate ( getIsoDateTime )
-import Darcs.Util.Lock ( readBinFile, removeFileMayNotExist, writeDocBinFile )
+import Darcs.Util.Lock ( readBinFile, removeFileMayNotExist, writeFormatBinFile )
 import Darcs.Util.Prompt ( promptYorn )
 import Darcs.Util.Tree ( Tree )
 
@@ -54,8 +54,8 @@ writeUnrevert recorded ps = do
   date <- getIsoDateTime
   info <- patchinfo date "unrevert" "anon" []
   let np = infopatch info ps
-  bundle <- makeBundle Nothing recorded (np :>: NilFL)
-  writeDocBinFile tentativeUnrevertPath bundle
+  let bundle = makeBundle recorded (np :>: NilFL)
+  writeFormatBinFile tentativeUnrevertPath bundle
 
 readUnrevert :: RepoPatch p
              => PatchSet p Origin wR
@@ -92,8 +92,8 @@ removeFromUnrevertContext ref ps =
               Nothing -> unrevert_impossible
               Just common -> do
                 debugMessage "Have now found the new context..."
-                bundle' <- makeBundle Nothing common (hopefully unrevert' :>: NilFL)
-                writeDocBinFile tentativeUnrevertPath bundle'
+                let bundle' = makeBundle common (hopefully unrevert' :>: NilFL)
+                writeFormatBinFile tentativeUnrevertPath bundle'
       _ -> return () -- TODO I guess this should be an error call
     debugMessage "Done adjusting the context of the unrevert changes"
   where
diff --git a/src/Darcs/Repository/Working.hs b/src/Darcs/Repository/Working.hs
index 7c362a46..200f6dde 100644
--- a/src/Darcs/Repository/Working.hs
+++ b/src/Darcs/Repository/Working.hs
@@ -1,42 +1,57 @@
 module Darcs.Repository.Working
     ( applyToWorking
+    , replaceWorking
     , setAllScriptsExecutable
     , setScriptsExecutablePatches
+    , notSoQuickApplyDiff
     )  where
 
-import Control.Monad ( when, unless, filterM )
-import System.Directory ( doesFileExist, withCurrentDirectory )
-import System.IO.Error ( catchIOError )
-
-import qualified Data.ByteString as B ( readFile
-                                      , isPrefixOf
-                                      )
-import qualified Data.ByteString.Char8 as BC (pack)
-
 import Darcs.Prelude
 
-import Darcs.Util.Progress ( debugMessage )
-import Darcs.Util.Workaround ( setExecutable )
-import Darcs.Util.Tree ( Tree )
-import Darcs.Util.Path ( anchorPath )
-import qualified Darcs.Util.Tree as Tree
+import Control.Monad ( filterM, unless, void, when )
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC ( pack )
+import qualified Data.ByteString.Lazy as BL
+import Data.List ( sortBy )
+import GHC.IO.Exception ( IOErrorType(..) )
+import System.Directory
+    ( createDirectory
+    , createDirectoryIfMissing
+    , doesFileExist
+    , removeDirectory
+    , removeFile
+    , withCurrentDirectory
+    )
+import System.IO ( hPutStrLn, stderr )
+import System.IO.Error ( catchIOError, ioeGetErrorType )
 
-import Darcs.Patch ( RepoPatch, PrimOf, apply, listTouchedFiles )
+import Darcs.Patch ( PrimOf, RepoPatch, apply, showPatch, listTouchedFiles )
 import Darcs.Patch.Apply ( ApplyState )
-import Darcs.Patch.Witnesses.Ordered
-    ( FL(..) )
 import Darcs.Patch.Inspect ( PatchInspect )
 import Darcs.Patch.Progress ( progressFL )
-
-import Darcs.Repository.Format ( RepoProperty( NoWorkingDir ), formatHas )
-import Darcs.Repository.Flags  ( Verbosity(..) )
+import Darcs.Patch.Witnesses.Ordered ( FL(..) )
+import Darcs.Patch.Witnesses.Sealed ( Sealed(..), unFreeLeft )
+import Darcs.Repository.ApplyPatches ( runSilently, runTolerantly )
+import Darcs.Repository.Diff ( treeDiff )
+import Darcs.Repository.Flags ( DiffAlgorithm, DiffOpts(..), Verbosity(..) )
+import Darcs.Repository.Format ( RepoProperty(NoWorkingDir), formatHas )
 import Darcs.Repository.InternalTypes
-    ( Repository
+    ( AccessType(..)
+    , Repository
     , repoFormat
     , repoLocation
-    , unsafeCoerceU )
-import Darcs.Repository.ApplyPatches ( runTolerantly, runSilently )
-import Darcs.Repository.State ( readWorking, TreeFilter(..)  )
+    , unsafeCoerceU
+    )
+import Darcs.Repository.Prefs ( filetypeFunction )
+import Darcs.Repository.State ( TreeFilter(..), readWorking )
+import Darcs.Util.File ( backupByRenaming )
+import Darcs.Util.Path ( anchorPath, realPath )
+import Darcs.Util.Printer ( renderString )
+import Darcs.Util.Progress ( debugMessage )
+import Darcs.Util.Tree ( Tree, TreeItem(..), diffTrees, zipTrees )
+import qualified Darcs.Util.Tree as Tree
+import Darcs.Util.Tree.Diff ( TreeDiff(..), getTreeDiff, organise )
+import Darcs.Util.Workaround ( setExecutable )
 
 applyToWorking :: (ApplyState p ~ Tree, RepoPatch p)
                => Repository rt p wU wR
@@ -46,7 +61,8 @@ applyToWorking :: (ApplyState p ~ Tree, RepoPatch p)
 applyToWorking repo verb ps =
   do
     unless (formatHas NoWorkingDir (repoFormat repo)) $ do
-      debugMessage "Applying changes to working tree"
+      debugMessage "Applying changes to working tree:"
+      debugMessage $ renderString $ showPatch ps
       withCurrentDirectory (repoLocation repo) $
         let ps' = progressFL "Applying patches to working" ps in
         if verb == Quiet
@@ -55,6 +71,126 @@ applyToWorking repo verb ps =
     return $ unsafeCoerceU repo
   `catchIOError` (\e -> fail $ "Error applying changes to working tree:\n" ++ show e)
 
+{-
+-- | Replace the working tree with pristine. This reverts all unrecorded changes,
+-- except for the addition of new files.
+replaceWorking :: Repository rt p wU wR -> IO (Repository rt p wR wR)
+replaceWorking r = do
+    tree <- readPristine r
+    withCurrentDirectory (repoLocation r) $ writeTree tree
+    return (unsafeCoerceU r)
+
+writeTree :: Tree IO -> IO ()
+writeTree t = Tree.expand t >>= mapM_ write . Tree.list
+  where
+    write (p, File b) = writeBlob p b
+    write (p, SubTree _) =
+      runTolerantly $ do
+        -- e <- mDoesDirectoryExist p
+        -- unless e
+        mCreateDirectory p
+    write _ = return ()
+    writeBlob p b = do
+      runTolerantly $ do
+        -- e <- mDoesFileExist p
+        -- unless e $ 
+      mCreateFile p
+      content <- Tree.readBlob b
+      runTolerantly $ mModifyFilePS p (\_ -> return (BL.toStrict content))
+-}
+
+-- | Change the working tree so that it coincides with pristine. Not quite as
+-- cheap as 'switchBranch' but a lot cheaper than applying the patchset
+-- difference between old and new repo state.
+--
+-- This is procedure has an ugly set of preconditions. It assumes that the
+-- first tree corresponds to what we get when we call 'readUnrecorded' in
+-- the unmodified repo. That is, it should represent the working state at
+-- the start of the transaction, including pending changes, but not including
+-- un-added files and directories. The second tree is supposed to be the
+-- (possibly) modified pristine tree.
+--
+-- This operates on a repo that is 'RO' because it is executed outside the
+-- transaction (like most operations on the working tree).
+--
+-- * TODO Move this to D.R.State?
+-- * TODO Replace files and directories atomically?
+replaceWorking
+  :: Repository 'RO p wU wR
+  -> DiffOpts
+  -> Tree IO -- old working tree
+  -> Tree IO -- new pristine tree
+  -> IO (Repository 'RO p wR wR)
+replaceWorking repo DiffOpts{} tree_old tree_new = do
+  quickApplyDiff tree_old tree_new
+  -- notSoQuickApplyDiff repo diffAlg tree_old tree_new
+  return (unsafeCoerceU repo)
+
+-- | Given an existing plain tree and another tree, update the first tree in
+-- place to be identical to the second one.
+--
+-- The twist here is that the first tree may contain less items than we have on
+-- disk due to un-added files and directories. We must backup these items
+-- before overwriting them. Any files and directories already known to darcs
+-- will be contained in the first tree; these are handled by merging unrecorded
+-- changes.
+quickApplyDiff :: Tree IO -> Tree IO -> IO ()
+quickApplyDiff tree_old tree_new = do
+    diffs <- diffTrees tree_old tree_new >>=
+      return . sortBy organise . uncurry (zipTrees getTreeDiff)
+    mapM_ (uncurry updateItem) diffs
+  where
+    updateItem p (Added n) = addItem (realPath p) n
+    updateItem p (Removed o) = removeItem (realPath p) o
+    updateItem p (Changed o n) = replaceItem (realPath p) o n
+
+    -- backup un-added files before overwriting them
+    addItem p (File b) = backupItem p >> writeBlob p b
+    -- backup and then remove a file with the same name
+    -- (existing directories need no backup, just the files in them)
+    addItem p (SubTree _) = do
+      e <- doesFileExist p
+      when e $ backupItem p
+      warning $ createDirectoryIfMissing False p
+    addItem _ (Stub {}) = error "impossible case"
+
+    removeItem p (SubTree _) =
+      removeDirectory p `catchIOError` \e ->
+        hPutStrLn stderr $
+          case ioeGetErrorType e of
+            UnsatisfiedConstraints ->
+              "Warning: Not deleting " ++ p ++ " because" ++ " it is not empty."
+            _ -> "Warning: Not deleting " ++ p ++ " because: " ++ show e
+    removeItem p (File _) = warning $ removeFile p
+    removeItem _ (Stub {}) = error "impossible case"
+
+    replaceItem p (File _) (File b) = writeBlob p b -- overwrite old content
+    replaceItem _ (SubTree _) (SubTree _) = return () -- children already handled
+    -- in the "mixed" case we have to remove existing items first
+    replaceItem p old new = removeItem p old >> writeItem p new
+
+    writeItem p (SubTree _) = warning $ createDirectory p
+    writeItem p (File b) = writeBlob p b
+    writeItem _ (Stub {}) = error "impossible case"
+
+    writeBlob p b = warning $ B.writeFile p . BL.toStrict =<< Tree.readBlob b
+
+    backupItem p = backupByRenaming p
+    handler e = hPutStrLn stderr $ "Warning: " ++ show e
+    warning job = job `catchIOError` handler
+
+notSoQuickApplyDiff
+  :: (ApplyState p ~ Tree, RepoPatch p)
+  => Repository 'RO p wU wR
+  -> DiffAlgorithm
+  -> Tree IO
+  -> Tree IO
+  -> IO ()
+notSoQuickApplyDiff repo da tree_old tree_new = do
+  ftf <- filetypeFunction
+  Sealed diff <- unFreeLeft <$> treeDiff da ftf tree_old tree_new
+  void $ applyToWorking repo NormalVerbosity diff
+
 -- | Set the given paths executable if they are scripts.
 --   A script is any file that starts with the bytes '#!'.
 --   This is used for --set-scripts-executable.
diff --git a/src/Darcs/UI/ApplyPatches.hs b/src/Darcs/UI/ApplyPatches.hs
index 2074c5c4..b955b4f3 100644
--- a/src/Darcs/UI/ApplyPatches.hs
+++ b/src/Darcs/UI/ApplyPatches.hs
@@ -32,21 +32,26 @@ import Darcs.Repository
     , tentativelyMergePatches
     , finalizeRepositoryChanges
     , applyToWorking
+    , readUnrecorded
     , setScriptsExecutablePatches
     )
 import Darcs.Repository.Pristine ( readPristine )
 import Darcs.Repository.Job ( RepoJob(RepoJob) )
+import Darcs.Repository.Working ( replaceWorking )
 import Darcs.Patch ( RepoPatch, description )
 import Darcs.Patch.Apply( ApplyState )
 import Darcs.Patch.FromPrim ( PrimOf )
+import Darcs.Patch.Progress ( progressFL )
 import Darcs.Patch.Set ( PatchSet, Origin )
 import Darcs.Patch.Witnesses.Ordered
-    ( FL, Fork(..), mapFL, nullFL )
-import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed) )
+    ( FL, Fork(..), (:>)(..), (+>+), mapFL, nullFL )
+import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
+import Darcs.Patch.Witnesses.Unsafe ( unsafeCoercePStart )
 
 import Darcs.Util.English ( presentParticiple )
 import Darcs.Util.Printer ( vcat, text )
 import Darcs.Util.Tree( Tree )
+import Darcs.Util.Progress ( debugMessage )
 
 data PatchProxy (p :: Type -> Type -> Type) = PatchProxy
 
@@ -90,8 +95,11 @@ standardApplyPatches :: (RepoPatch p, ApplyState p ~ Tree)
 standardApplyPatches cmdName opts repository patches@(Fork _ _ to_be_applied) = do
     !no_patches <- return (nullFL to_be_applied)
     applyPatchesStart cmdName opts to_be_applied
-    Sealed pw <- mergeAndTest cmdName opts repository patches
-    applyPatchesFinish cmdName opts repository pw (not no_patches)
+    -- this is the working tree without un-added items (but with pending adds)
+    -- FIXME Why does this not work with O.UseIndex?????
+    working_tree <- readUnrecorded repository O.IgnoreIndex Nothing
+    pw <- mergeAndTest cmdName opts repository patches
+    applyPatchesFinish cmdName opts repository working_tree pw (not no_patches)
 
 mergeAndTest :: (RepoPatch p, ApplyState p ~ Tree)
              => String
@@ -100,7 +108,7 @@ mergeAndTest :: (RepoPatch p, ApplyState p ~ Tree)
              -> Fork (PatchSet p)
                      (FL (PatchInfoAnd p))
                      (FL (PatchInfoAnd p)) Origin wR wZ
-             -> IO (Sealed (FL (PrimOf p) wU))
+             -> IO (Sealed ((FL (PrimOf p) :> FL (PrimOf p)) wR))
 mergeAndTest cmdName opts repository patches = do
     pw <- tentativelyMergePatches repository cmdName
                          (allowConflicts opts)
@@ -133,15 +141,22 @@ applyPatchesFinish :: (RepoPatch p, ApplyState p ~ Tree)
                    => String
                    -> [DarcsFlag]
                    -> Repository 'RW p wU wR
-                   -> FL (PrimOf p) wU wY
+                   -> Tree IO
+                   -> Sealed ((FL (PrimOf p) :> FL (PrimOf p)) wR)
                    -> Bool
                    -> IO ()
-applyPatchesFinish cmdName opts _repository pw any_applied = do
+applyPatchesFinish cmdName opts _repository old_working (Sealed (them' :> pw)) any_applied = do
+    new_pristine <- readPristine _repository
     withSignalsBlocked $ do
         _repository <- finalizeRepositoryChanges _repository (O.dryRun ? opts)
-        void $ applyToWorking _repository (verbosity ? opts) pw
+        debugMessage "Replacing working tree with (new) pristine"
+        _repository <-
+            replaceWorking _repository (diffingOpts opts) old_working new_pristine
+        debugMessage "Applying new pending/working changes"
+        void $ applyToWorking _repository (verbosity ? opts) (unsafeCoercePStart pw)
         when (setScriptsExecutable ? opts == O.YesSetScriptsExecutable) $
-            setScriptsExecutablePatches pw
+            setScriptsExecutablePatches $
+            progressFL "Setting files executable" $ them' +>+ pw
     case (any_applied, reorder ? opts == O.Reorder) of
         (True,True)  -> putFinished opts $ "reordering"
         (False,True) -> putFinished opts $ presentParticiple cmdName ++ " and reordering"
diff --git a/src/Darcs/UI/Commands.hs b/src/Darcs/UI/Commands.hs
index a29ebc7c..054d26ad 100644
--- a/src/Darcs/UI/Commands.hs
+++ b/src/Darcs/UI/Commands.hs
@@ -49,6 +49,7 @@ module Darcs.UI.Commands
     , amInRepository
     , amNotInRepository
     , findRepository
+    , noPrereq
     ) where
 
 import Control.Monad ( when, unless )
@@ -143,7 +144,7 @@ data DarcsCommand =
                               -- second one is the path where darcs was executed.
                               (AbsolutePath, AbsolutePath)
                            -> [DarcsFlag] -> [String] -> IO ()
-          , commandPrereq :: [DarcsFlag] -> IO (Either String ())
+          , commandPrereq :: CommandPrereq
           , commandCompleteArgs :: (AbsolutePath, AbsolutePath)
                                 -> [DarcsFlag] -> [String] -> IO [String]
           , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String]
@@ -155,10 +156,12 @@ data DarcsCommand =
           , commandName :: String
           , commandHelp :: Doc
           , commandDescription :: String
-          , commandPrereq :: [DarcsFlag] -> IO (Either String ())
+          , commandPrereq :: CommandPrereq
           , commandSubCommands :: [CommandControl]
           }
 
+type CommandPrereq = [DarcsFlag] -> IO (Either String ())
+
 data CommandOptions = CommandOptions
   { coBasicOptions :: [DarcsOptDescr DarcsFlag]
   , coAdvancedOptions :: [DarcsOptDescr DarcsFlag]
@@ -348,15 +351,18 @@ defaultRepo :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
 defaultRepo _ _ [] = maybeToList <$> getDefaultRepo
 defaultRepo _ _ args = return args
 
-amInHashedRepository :: [DarcsFlag] -> IO (Either String ())
+amInHashedRepository :: CommandPrereq
 amInHashedRepository fs = R.amInHashedRepository (workRepo fs)
 
-amInRepository :: [DarcsFlag] -> IO (Either String ())
+amInRepository :: CommandPrereq
 amInRepository fs = R.amInRepository (workRepo fs)
 
-amNotInRepository :: [DarcsFlag] -> IO (Either String ())
+amNotInRepository :: CommandPrereq
 amNotInRepository fs =
   R.amNotInRepository (maybe WorkRepoCurrentDir WorkRepoDir (newRepo ? fs))
 
-findRepository :: [DarcsFlag] -> IO (Either String ())
+findRepository :: CommandPrereq
 findRepository fs = R.findRepository (workRepo fs)
+
+noPrereq :: CommandPrereq
+noPrereq _ = return $ Right ()
diff --git a/src/Darcs/UI/Commands/Amend.hs b/src/Darcs/UI/Commands/Amend.hs
index 5b7272b4..f660076a 100644
--- a/src/Darcs/UI/Commands/Amend.hs
+++ b/src/Darcs/UI/Commands/Amend.hs
@@ -88,7 +88,7 @@ import Darcs.Repository
     , readPendingAndWorking
     , readPristine
     , readPatches
-    , tentativelyRemoveFromPW
+    , tentativelyRemoveFromPending
     )
 import Darcs.Repository.Pending ( readTentativePending, writeTentativePending )
 import Darcs.Repository.Prefs ( getDefaultRepo )
@@ -106,7 +106,7 @@ import Darcs.Patch.Witnesses.Ordered
     ( FL(..), RL, (:>)(..), (+>+)
     , nullFL, reverseRL, reverseFL, mapFL_FL
     )
-import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
+import Darcs.Patch.Witnesses.Sealed ( Sealed(..), Sealed2(..) )
 
 import Darcs.Util.English ( anyOfClause, itemizeVertical )
 import Darcs.Util.Printer ( Doc, formatWords, putDocLn, text, (<+>), ($$), ($+$) )
@@ -215,7 +215,7 @@ doAmend cfg files =
                        (Just (primSplitter da))
                        files
             (chosenPatches :> _) <- runInvertibleSelection ch selection_config
-            addChangesToPatch cfg repository kept oldp chosenPatches pending working
+            addChangesToPatch cfg repository kept oldp chosenPatches pending
       if not (isTag (info oldp))
         -- amending a normal patch
         then
@@ -228,7 +228,7 @@ doAmend cfg files =
               (_ :> chosenPrims) <-
                 runInvertibleSelection (effect oldp) selection_config
               let invPrims = reverseRL (invertFL chosenPrims)
-              addChangesToPatch cfg repository kept oldp invPrims pending working
+              addChangesToPatch cfg repository kept oldp invPrims pending
             else do
               let maybeCanonize = if O.canonize ? cfg then canonizeFL da else id
               go (maybeCanonize (pending +>+ working))
@@ -259,9 +259,8 @@ addChangesToPatch
   -> PatchInfoAnd p wX wR       -- ^ original patch
   -> FL (PrimOf p) wR wY        -- ^ changes to add
   -> FL (PrimOf p) wR wP        -- ^ pending
-  -> FL (PrimOf p) wP wU        -- ^ working
   -> IO ()
-addChangesToPatch cfg _repository context oldp chs pending working =
+addChangesToPatch cfg _repository context oldp chs pending =
   if nullFL chs && not (hasEditMetadata cfg)
     then putInfo cfg "You don't want to record anything!"
     else do
@@ -315,7 +314,7 @@ addChangesToPatch cfg _repository context oldp chs pending working =
       if O.amendUnrecord ? cfg then
         writeTentativePending _repository $ invert chs +>+ old_pending
       else
-        tentativelyRemoveFromPW _repository chs pending working
+        tentativelyRemoveFromPending _repository chs pending
       _repository <-
         finalizeRepositoryChanges _repository (O.dryRun ? cfg)
           `clarifyErrors` failmsg
@@ -348,7 +347,8 @@ filterNotInRemote cfg repository patchSet = do
         return (in_remote :> reverseFL only_ours)
   where
     readNir loc = do
-      repo <- identifyRepositoryFor Reading repository (O.useCache ? cfg) loc
+      Sealed2 repo <-
+        identifyRepositoryFor Reading repository (O.useCache ? cfg) loc
       rps <- readPatches repo
       return (Sealed rps)
     getNotInRemotePath (O.NotInRemotePath p) = return p
diff --git a/src/Darcs/UI/Commands/Annotate.hs b/src/Darcs/UI/Commands/Annotate.hs
index e92f8b98..c72c8c17 100644
--- a/src/Darcs/UI/Commands/Annotate.hs
+++ b/src/Darcs/UI/Commands/Annotate.hs
@@ -42,7 +42,7 @@ import qualified Data.ByteString.Char8 as BC ( pack, concat, intercalate )
 import Data.ByteString.Lazy ( toChunks )
 import Darcs.Patch.ApplyMonad( withFileNames )
 import Darcs.Patch.Match ( patchSetMatch, rollbackToPatchSetMatch  )
-import Darcs.Repository.Match ( getOnePatchset )
+import Darcs.Patch.Match ( matchOnePatchset )
 import Darcs.Repository.PatchIndex ( getRelevantSubsequence, canUsePatchIndex )
 import Darcs.Patch.Witnesses.Sealed ( Sealed(..), seal )
 import qualified Darcs.Patch.Annotate as A
@@ -104,7 +104,7 @@ annotateCmd' opts fixed_path = withRepository (useCache ? opts) $ RepoJob $ \rep
   (patches, initial, path) <-
     case patchSetMatch matchFlags of
       Just psm -> do
-        Sealed x <- getOnePatchset repository psm
+        Sealed x <- matchOnePatchset r psm
         case withFileNames Nothing [fixed_path] (rollbackToPatchSetMatch psm r) of
           (_, [path'], _) -> do
             initial <- snd `fmap` virtualTreeIO (rollbackToPatchSetMatch psm r) recorded
diff --git a/src/Darcs/UI/Commands/Apply.hs b/src/Darcs/UI/Commands/Apply.hs
index 8c7c2962..12844a92 100644
--- a/src/Darcs/UI/Commands/Apply.hs
+++ b/src/Darcs/UI/Commands/Apply.hs
@@ -53,7 +53,7 @@ import Darcs.Repository
 import Darcs.Patch.Set ( PatchSet, Origin )
 import Darcs.Patch ( RepoPatch )
 import Darcs.Patch.Apply( ApplyState )
-import Darcs.Patch.Info ( PatchInfo, displayPatchInfo )
+import Darcs.Patch.Info ( PatchInfo, showPatchInfo )
 import Darcs.Patch.Witnesses.Ordered
     ( Fork(..), (:>)(..)
     , mapFL, nullFL )
@@ -231,7 +231,7 @@ applyCmdCommon patchApplier patchProxy opts bundle repository = do
   unless (null bad) $
     fail $
     renderString $
-      (vcat $ map displayPatchInfo bad) $$ text "" $$
+      (vcat $ map showPatchInfo bad) $$ text "" $$
       text "Cannot apply this bundle. We are missing the above patches."
 
   (hadConflicts, Sealed their_ps)
diff --git a/src/Darcs/UI/Commands/Clone.hs b/src/Darcs/UI/Commands/Clone.hs
index a0f5adb5..e725c6f7 100644
--- a/src/Darcs/UI/Commands/Clone.hs
+++ b/src/Darcs/UI/Commands/Clone.hs
@@ -32,13 +32,16 @@ import System.Exit ( ExitCode(..) )
 import System.FilePath.Posix ( joinPath, splitDirectories )
 import Control.Monad ( when, unless )
 
-import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts
-                      , nodefaults
-                      , commandStub
-                      , commandAlias
-                      , putInfo
-                      , putFinished
-                      )
+import Darcs.UI.Commands
+    ( DarcsCommand(..)
+    , commandAlias
+    , commandStub
+    , noPrereq
+    , nodefaults
+    , putFinished
+    , putInfo
+    , withStdOpts
+    )
 import Darcs.UI.Completion ( noArgs )
 import Darcs.UI.Flags
     ( DarcsFlag
@@ -48,7 +51,6 @@ import Darcs.UI.Flags
     , quiet
     , setDefault
     , setScriptsExecutable
-    , umask
     , useCache
     , usePacks
     , verbosity
@@ -62,14 +64,14 @@ import Darcs.UI.Commands.Util
     , getUniqueRepositoryName
     )
 import Darcs.Patch.Match ( MatchFlag(..) )
-import Darcs.Repository ( cloneRepository )
+import Darcs.Repository ( cloneRepository, withUMaskFlag )
 import Darcs.Repository.Format ( identifyRepoFormat
                                , RepoProperty ( HashedInventory
                                               , RebaseInProgress
                                               )
                                , formatHas
                                )
-import Darcs.Util.Lock ( withTempDir )
+import Darcs.Util.Lock ( withNewDirectory, withTempDir )
 import Darcs.Util.Ssh ( getSSH, SSHCmd(SCP,SSH) )
 import Darcs.Repository.Flags
     ( CloneKind(CompleteClone), SetDefault(NoSetDefault), ForgetParent(..) )
@@ -133,7 +135,7 @@ clone = DarcsCommand
     , commandExtraArgs = -1
     , commandExtraArgHelp = ["<REPOSITORY>", "[<DIRECTORY>]"]
     , commandCommand = cloneCmd
-    , commandPrereq = \_ -> return $ Right ()
+    , commandPrereq = noPrereq
     , commandCompleteArgs = noArgs
     , commandArgdefaults = nodefaults
     , commandOptions = cloneOpts
@@ -172,7 +174,8 @@ put :: DarcsCommand
 put = commandStub "put" putHelp putDescription clone
 
 cloneCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
-cloneCmd fps opts [inrepodir, outname] = cloneCmd fps (withNewRepo outname opts) [inrepodir]
+cloneCmd fps opts [inrepodir, outname] =
+  cloneCmd fps (withNewRepo outname opts) [inrepodir]
 cloneCmd (_,o) opts [inrepodir] = do
   debugMessage "Starting work on clone..."
   repodir <- fixUrl o inrepodir
@@ -197,25 +200,22 @@ cloneCmd (_,o) opts [inrepodir] = do
     $$ text ""
     $$ text "***********************************************************************"
 
-  case cloneToSSH opts of
+  withUMaskFlag (O.umask ? opts) $
+   case cloneToSSH opts of
     Just repo -> do
       withTempDir "clone" $ \_ -> do
          prepareRemoteDir repo
          putInfo opts $ text "Creating local clone..."
          currentDir <- getCurrentDirectory
          mysimplename <- makeRepoName True [] repodir -- give correct name to local clone
-         cloneRepository repodir mysimplename (verbosity ? opts) (useCache ? opts)
-                         CompleteClone (umask ? opts) (O.remoteDarcs ? opts)
-                         (setScriptsExecutable ? opts)
-                         (NoSetDefault True)
-                         O.NoInheritDefault -- never inherit defaultrepo when cloning to ssh
-                         (map convertUpToToOne (O.matchOneContext ? opts))
-                         rfsource
-                         (withWorkingDir ? opts)
-                         (patchIndexNo ? opts)
-                         (usePacks ? opts)
-                         YesForgetParent
-                         (O.withPrefsTemplates ? opts)
+         withNewDirectory mysimplename $
+           doit
+             repodir
+             CompleteClone
+             (NoSetDefault True)
+             O.NoInheritDefault -- never inherit defaultrepo when cloning to ssh
+             rfsource
+             YesForgetParent
          setCurrentDirectory currentDir
          (scp, args) <- getSSH SCP
          putInfo opts $ text $ "Transferring clone using " ++ scp ++ "..."
@@ -229,19 +229,33 @@ cloneCmd (_,o) opts [inrepodir] = do
          putInfo opts $ text "Cloning and transferring successful."
     Nothing -> do
       mysimplename <- makeRepoName True opts repodir
-      cloneRepository repodir mysimplename (verbosity ? opts) (useCache ? opts)
-                  (cloneKind ? opts) (umask ? opts) (O.remoteDarcs ? opts)
-                  (setScriptsExecutable ? opts)
-                  (setDefault True opts)
-                  (O.inheritDefault ? opts)
-                  (map convertUpToToOne (O.matchOneContext ? opts))
-                  rfsource
-                  (withWorkingDir ? opts)
-                  (patchIndexNo ? opts)
-                  (usePacks ? opts)
-                  NoForgetParent
-                  (O.withPrefsTemplates ? opts)
+      withNewDirectory mysimplename $
+        doit
+          repodir
+          (cloneKind ? opts)
+          (setDefault True opts)
+          (O.inheritDefault ? opts)
+          rfsource
+          NoForgetParent
       putFinished opts "cloning"
+  where
+    doit repodir clone_kind set_default inherit_default rfsource forget_parent =
+      cloneRepository
+        repodir
+        (verbosity ? opts)
+        (useCache ? opts)
+        clone_kind
+        (O.remoteDarcs ? opts)
+        (setScriptsExecutable ? opts)
+        set_default
+        inherit_default
+        (map convertUpToToOne (O.matchOneContext ? opts))
+        rfsource
+        (withWorkingDir ? opts)
+        (patchIndexNo ? opts)
+        (usePacks ? opts)
+        forget_parent
+        (O.withPrefsTemplates ? opts)
 
 cloneCmd _ _ _ = fail "You must provide 'clone' with either one or two arguments."
 
diff --git a/src/Darcs/UI/Commands/Convert/Darcs2.hs b/src/Darcs/UI/Commands/Convert/Darcs2.hs
index b9a99380..5a3091d0 100644
--- a/src/Darcs/UI/Commands/Convert/Darcs2.hs
+++ b/src/Darcs/UI/Commands/Convert/Darcs2.hs
@@ -28,7 +28,7 @@ import System.Directory ( doesDirectoryExist, doesFileExist )
 
 import Darcs.Prelude
 
-import Darcs.Patch ( RepoPatch, effect, displayPatch )
+import Darcs.Patch ( RepoPatch, effect, showPatch )
 import Darcs.Patch.Apply ( ApplyState )
 import Darcs.Patch.Info ( isTag, piRename, piTag )
 import Darcs.Patch.Named ( Named(..), getdeps, patch2patchinfo, patchcontents )
@@ -63,6 +63,7 @@ import Darcs.Repository
     , finalizeRepositoryChanges
     , readPatches
     , revertRepositoryChanges
+    , tentativelyAddPatch
     , withRepositoryLocation
     , withUMaskFlag
     )
@@ -72,10 +73,15 @@ import Darcs.Repository.Format
     , formatHas
     , identifyRepoFormat
     )
-import Darcs.Repository.Hashed ( UpdatePristine(..), tentativelyAddPatch_ )
 import Darcs.Repository.Prefs ( showMotd, prefsFilePath )
 
-import Darcs.UI.Commands ( DarcsCommand(..), nodefaults, putFinished, withStdOpts )
+import Darcs.UI.Commands
+    ( DarcsCommand(..)
+    , noPrereq
+    , nodefaults
+    , putFinished
+    , withStdOpts
+    )
 import Darcs.UI.Commands.Convert.Util ( updatePending )
 import Darcs.UI.Commands.Util ( commonHelpWithPrefsTemplates )
 import Darcs.UI.Completion ( noArgs )
@@ -134,7 +140,7 @@ convertDarcs2 = DarcsCommand
     , commandExtraArgs = -1
     , commandExtraArgHelp = ["<SOURCE>", "[<DESTINATION>]"]
     , commandCommand = toDarcs2
-    , commandPrereq = \_ -> return $ Right ()
+    , commandPrereq = noPrereq
     , commandCompleteArgs = noArgs
     , commandArgdefaults = nodefaults
     , commandOptions = opts
@@ -190,11 +196,11 @@ toDarcs2 _ opts' args = do
                  IsEq -> y :>: NilFL
                  NotEq ->
                      traceDoc (text "lossy conversion:" $$
-                               displayPatch x) $
+                               showPatch x) $
                      mapFL_FL V2.Normal ex
              Nothing -> traceDoc (text
                                   "lossy conversion of complicated conflict:" $$
-                                  displayPatch x) $
+                                  showPatch x) $
                         mapFL_FL V2.Normal ex
           convertOne (V1.PP x) = V2.Normal (primV1toV2 x) :>: NilFL
           convertOne _ = error "impossible case"
@@ -228,7 +234,7 @@ toDarcs2 _ opts' args = do
              -> IO (W2 (Repository 'RW p) wY)
     applyOne opts (W2 _repo) x = do
       _repo <-
-        tentativelyAddPatch_ (updatePristine opts) _repo (updatePending opts) x
+        tentativelyAddPatch _repo (updatePending opts) x
       _repo <- applyToWorking _repo (verbosity ? opts) (effect x)
       return (W2 _repo)
 
@@ -239,15 +245,6 @@ toDarcs2 _ opts' args = do
              -> IO (Repository 'RW p wY wY)
     applyAll opts r xss = unW2 <$> foldFL_M (applyOne opts) (W2 r) xss
 
-    updatePristine :: [DarcsFlag] -> UpdatePristine
-    updatePristine opts =
-      case withWorkingDir ? opts of
-        O.WithWorkingDir -> UpdatePristine
-        -- this should not be necessary but currently is, because
-        -- some commands (e.g. send) cannot cope with a missing pristine
-        -- even if the repo is marked as having no working tree
-        O.NoWorkingDir -> {- DontUpdatePristineNorRevert -}UpdatePristine
-
 -- | Need this to make 'foldFL_M' work with a function that changes
 -- the last two (identical) witnesses at the same time.
 newtype W2 r wX = W2 {unW2 :: r wX wX}
diff --git a/src/Darcs/UI/Commands/Convert/Export.hs b/src/Darcs/UI/Commands/Convert/Export.hs
index f59dc833..b69fb6a6 100644
--- a/src/Darcs/UI/Commands/Convert/Export.hs
+++ b/src/Darcs/UI/Commands/Convert/Export.hs
@@ -99,7 +99,7 @@ import qualified Darcs.UI.Options.All as O
 import Darcs.Util.DateTime ( formatDateTime, fromClockTime )
 import Darcs.Util.Path
     ( AbsolutePath
-    , AnchoredPath(..)
+    , AnchoredPath
     , anchorPath
     , appendPath
     , toFilePath
diff --git a/src/Darcs/UI/Commands/Convert/Import.hs b/src/Darcs/UI/Commands/Convert/Import.hs
index 2e4c0878..0e6f5821 100644
--- a/src/Darcs/UI/Commands/Convert/Import.hs
+++ b/src/Darcs/UI/Commands/Convert/Import.hs
@@ -15,7 +15,7 @@
 --  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 --  Boston, MA 02110-1301, USA.
 
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, NamedFieldPuns #-}
 
 module Darcs.UI.Commands.Convert.Import ( convertImport ) where
 
@@ -38,7 +38,6 @@ import Data.Word (Word8)
 
 import Safe (headErr, tailErr)
 
-import System.Directory (doesFileExist)
 import System.FilePath.Posix ((</>))
 import System.IO (stdin)
 
@@ -70,16 +69,17 @@ import Darcs.Repository
     , repoCache
     , revertRepositoryChanges
     , withUMaskFlag
+    , writePristine
     )
 import Darcs.Repository.Diff (treeDiff)
 import Darcs.Repository.Hashed (addToTentativeInventory)
-import Darcs.Repository.Paths (tentativePristinePath)
 import Darcs.Repository.Prefs (FileType(..))
 import Darcs.Repository.State (readPristine)
 
 import Darcs.UI.Commands
     ( DarcsCommand(..)
     , nodefaults
+    , noPrereq
     , withStdOpts
     )
 import Darcs.UI.Commands.Convert.Util
@@ -109,7 +109,7 @@ import Darcs.Util.DateTime
     , startOfTime
     )
 import Darcs.Util.Global (darcsdir)
-import Darcs.Util.Hash (encodeBase16, sha256)
+import Darcs.Util.Hash ( sha256 )
 import Darcs.Util.Lock (withNewDirectory)
 import Darcs.Util.Path
     ( AbsolutePath
@@ -130,7 +130,6 @@ import Darcs.Util.Tree
     , readBlob
     , treeHasDir
     , treeHasFile
-    , treeHash
     )
 import Darcs.Util.Tree.Hashed (darcsAddMissingHashes, hashedTreeIO)
 import qualified Darcs.Util.Tree.Monad as TM
@@ -162,7 +161,7 @@ convertImport = DarcsCommand
     , commandExtraArgs = -1
     , commandExtraArgHelp = ["[<DIRECTORY>]"]
     , commandCommand = fastImport
-    , commandPrereq = \_ -> return $ Right ()
+    , commandPrereq = noPrereq
     , commandCompleteArgs = noArgs
     , commandArgdefaults = nodefaults
     , commandOptions = opts
@@ -214,8 +213,20 @@ data Object = Blob (Maybe Int) Content
 
 type Ancestors = (Marked, [Int])
 data State p where
-  Toplevel :: Marked -> Branch -> State p
-  InCommit :: Marked -> Ancestors -> Branch -> Tree IO -> RL (PrimOf p) cX cY -> PatchInfo -> State p
+  Toplevel
+    :: { mark :: Marked
+       , branch :: Branch
+       }
+    -> State p
+  InCommit
+    :: { mark :: Marked
+       , ancestors :: Ancestors
+       , branch :: Branch
+       , tree_ :: Tree IO
+       , ps :: RL (PrimOf p) cX cY
+       , info :: PatchInfo
+       }
+    -> State p
   Done :: State p
 
 instance Show (State p) where
@@ -250,7 +261,10 @@ fastImport' :: forall p wU wR . (RepoPatch p, ApplyState p ~ Tree)
 fastImport' repo diffalg marks = do
     pristine <- readPristine repo
     marksref <- newIORef marks
-    let initial = Toplevel Nothing $ BC.pack "refs/branches/master"
+    let initial = Toplevel
+          { mark = Nothing
+          , branch = BC.pack "refs/branches/master"
+          }
 
         go :: State p -> B.ByteString -> TreeIO ()
         go state rest = do (rest', item) <- parseObject rest
@@ -277,9 +291,7 @@ fastImport' repo diffalg marks = do
 
         addtag author msg =
           do info_ <- makeinfo author msg True
-             gotany <- liftIO $ doesFileExist tentativePristinePath
-             deps <- if gotany then liftIO $ getUncovered `fmap` readPatches repo
-                               else return []
+             deps <- liftIO $ getUncovered `fmap` readPatches repo
              let patch :: Named p wA wA
                  patch = NamedP info_ deps NilFL
              liftIO $
@@ -318,12 +330,12 @@ fastImport' repo diffalg marks = do
 
         -- generate Hunk primitive patches from diffing
         diffCurrent :: State p -> TreeIO (State p)
-        diffCurrent (InCommit mark ancestors branch start ps info_) = do
+        diffCurrent InCommit{tree_=start,..} = do
           current <- updateHashes
           Sealed diff <- unFreeLeft `fmap`
              liftIO (treeDiff diffalg (const TextFile) start current)
           let newps = ps +<<+ diff
-          return $ InCommit mark ancestors branch current newps info_
+          return InCommit{ps=newps,tree_=current,..}
         diffCurrent _ = error "This is never valid outside of a commit."
 
         process :: State p -> Object -> TreeIO (State p)
@@ -331,77 +343,73 @@ fastImport' repo diffalg marks = do
           liftIO $ putStrLn ("progress " ++ decodeLocale p)
           return s
 
-        process (Toplevel _ _) End = do
+        process Toplevel{} End = do
+          -- lets dump the right tree, without _darcs
           tree' <- (liftIO . darcsAddMissingHashes) =<< updateHashes
-          modify $ \s -> s { tree = tree' } -- lets dump the right tree, without _darcs
-          let root =
-                case treeHash tree' of
-                  Nothing -> error "tree has no hash!"
-                  Just hash -> encodeBase16 hash
           liftIO $ do
+            _ <- writePristine repo tree'
             putStrLn "\\o/ It seems we survived. Enjoy your new repo."
-            B.writeFile tentativePristinePath $ BC.concat [BC.pack "pristine:", root]
           return Done
 
-        process (Toplevel n b) (Tag tag what author msg) = do
-          if Just what == n
+        process s@Toplevel{mark} (Tag tag what author msg) = do
+          if Just what == mark
              then addtag author msg
              else liftIO $ putStrLn $
                     "WARNING: Ignoring out-of-order tag " ++ decodeLocale tag
-          return (Toplevel n b)
+          return s
 
-        process (Toplevel n _) (Reset branch from) =
+        process s@Toplevel{mark} (Reset branch from) =
           do case from of
-               (Just (MarkId k)) | Just k == n ->
+               (Just (MarkId k)) | Just k == mark ->
                  addtag (BC.pack "Anonymous Tagger <> 0 +0000") branch
                _ -> liftIO $ putStrLn $ "WARNING: Ignoring out-of-order tag " ++
                                         decodeLocale branch
-             return $ Toplevel n branch
+             return s{branch}
 
-        process (Toplevel n b) (Blob (Just m) bits) = do
+        process s@Toplevel{} (Blob (Just m) bits) = do
           TM.writeFile (markpath m) (BLC.fromChunks [bits])
-          return $ Toplevel n b
+          return s
 
         process x (Gitlink link) = do
           liftIO $ putStrLn $ "WARNING: Ignoring gitlink " ++ decodeLocale link
           return x
 
-        process (Toplevel previous pbranch) (Commit branch mark author message) = do
+        process Toplevel{mark=previous,branch=pbranch} (Commit branch mark author message) = do
           when (pbranch /= branch) $ do
             liftIO $ putStrLn ("Tagging branch: " ++ decodeLocale pbranch)
             addtag author pbranch
-          info_ <- makeinfo author message False
-          startstate <- updateHashes
-          return $ InCommit mark (previous, []) branch startstate NilRL info_
+          info <- makeinfo author message False
+          tree_ <- updateHashes
+          return InCommit{ancestors=(previous,[]),ps=NilRL,..}
 
-        process s@InCommit {} (Modify (Left m) path) = do
+        process s@InCommit{} (Modify (Left m) path) = do
           TM.copy (markpath m) (decodePath path)
           diffCurrent s
 
-        process s@InCommit {} (Modify (Right bits) path) = do
+        process s@InCommit{} (Modify (Right bits) path) = do
           TM.writeFile (decodePath path) (BLC.fromChunks [bits])
           diffCurrent s
 
-        process s@InCommit {} (Delete path) = do
+        process s@InCommit{} (Delete path) = do
           let floatedPath = decodePath path
           TM.unlink floatedPath
           deleteEmptyParents floatedPath
           diffCurrent s
 
-        process (InCommit mark (prev, current) branch start ps info_) (From from) =
-          return $ InCommit mark (prev, from:current) branch start ps info_
+        process s@InCommit{ancestors=(prev,current)} (From from) =
+          return s{ancestors=(prev, from:current)}
 
-        process (InCommit mark (prev, current) branch start ps info_) (Merge from) =
-          return $ InCommit mark (prev, from:current) branch start ps info_
+        process s@InCommit{ancestors=(prev,current)} (Merge from) =
+          return $ s{ancestors=(prev, from:current)}
 
-        process s@InCommit {} (Copy names) = do
+        process s@InCommit{} (Copy names) = do
             (from, to) <- extractNames names
             TM.copy (decodePath from) (decodePath to)
             -- We can't tell Darcs that a file has been copied, so it'll
             -- show as an addfile.
             diffCurrent s
 
-        process s@(InCommit mark ancestors branch start _ info_) (Rename names) = do
+        process s@InCommit{tree_=start,..} (Rename names) = do
           (from, to) <- extractNames names
           let uFrom = decodePath from
               uTo = decodePath to
@@ -419,18 +427,18 @@ fastImport' repo diffalg marks = do
               if targetDirExists || targetFileExists
                   then TM.unlink uTo
                   else unless parentDirExists $ TM.createDirectory parentDir
-          (InCommit _ _ _ _ newPs _) <- diffCurrent s
+          InCommit{ps=newPs} <- diffCurrent s
           TM.rename uFrom uTo
           let ps' = newPs :<: move uFrom uTo
           current <- updateHashes
           -- ensure empty dirs get deleted
           deleteEmptyParents uFrom
           -- run diffCurrent to add the dir deletions prims
-          diffCurrent (InCommit mark ancestors branch current ps' info_)
+          diffCurrent InCommit{tree_=current,ps=ps',..}
 
         -- When we leave the commit, create a patch for the cumulated
         -- prims.
-        process (InCommit mark ancestors branch _ ps info_) x = do
+        process InCommit{..} x = do
           case ancestors of
             (_, []) -> return () -- OK, previous commit is the ancestor
             (Just n, list)
@@ -442,21 +450,20 @@ fastImport' repo diffalg marks = do
               liftIO $ putStrLn $ "WARNING: Linearising non-linear ancestry " ++ show list
 
           {- current <- updateHashes -} -- why not?
-          (prims :: FL (PrimOf p) cX cY) <-
+          prims' :: FL (PrimOf p) cX cY <-
             return $ canonizeFL diffalg $ reverseRL ps
           let patch :: Named p cX cY
-              patch = infopatch info_ prims
-          liftIO $
-              addToTentativeInventory (repoCache repo) (n2pia patch)
+              patch = infopatch info prims'
+          liftIO $ addToTentativeInventory (repoCache repo) (n2pia patch)
           case mark of
             Nothing -> return ()
             Just n -> case getMark marks n of
               Nothing -> liftIO $ modifyIORef marksref $ \m -> addMark m n (patchHash $ n2pia patch)
               Just n' -> fail $ "FATAL: Mark already exists: " ++ decodeLocale n'
-          process (Toplevel mark branch) x
+          process Toplevel{..} x
 
         process state obj = do
-          liftIO $ print obj
+          liftIO $ putStrLn $ show obj
           fail $ "Unexpected object in state " ++ show state
 
         extractNames :: CopyRenameNames
diff --git a/src/Darcs/UI/Commands/Diff.hs b/src/Darcs/UI/Commands/Diff.hs
index 54f0aea2..bb726165 100644
--- a/src/Darcs/UI/Commands/Diff.hs
+++ b/src/Darcs/UI/Commands/Diff.hs
@@ -29,7 +29,7 @@ import System.IO ( hFlush, stdout )
 import Darcs.Patch ( listTouchedFiles )
 import Darcs.Patch.Apply ( Apply(..) )
 import Darcs.Patch.Depends ( findCommonWithThem )
-import Darcs.Patch.Info ( displayPatchInfo )
+import Darcs.Patch.Info ( showPatchInfo )
 import Darcs.Patch.Match ( matchFirstPatchset, matchSecondPatchset, secondMatch )
 import Darcs.Patch.Named ( anonymous )
 import Darcs.Patch.PatchInfoAnd ( info, n2pia )
@@ -227,7 +227,7 @@ doDiff opts mpaths = withRepository (useCache ? opts) $ RepoJob $ \repository ->
         writePlainTree (applyTreeFilter relevant oldtree) (toFilePath odir)
         writePlainTree (applyTreeFilter relevant newtree) (toFilePath ndir)
         -- Display patch info for (only) the recorded patches that we diff
-        putDocLn $ vcat $ map displayPatchInfo $ reverse $ mapFL info tolog
+        putDocLn $ vcat $ map showPatchInfo $ reverse $ mapFL info tolog
         hFlush stdout
 
       -- Call the external diff program. Note we are now back in our
diff --git a/src/Darcs/UI/Commands/Help.hs b/src/Darcs/UI/Commands/Help.hs
index e81a9ad0..34c8358d 100644
--- a/src/Darcs/UI/Commands/Help.hs
+++ b/src/Darcs/UI/Commands/Help.hs
@@ -46,6 +46,7 @@ import Darcs.UI.Commands
     , disambiguateCommands
     , extractCommands
     , getSubcommands
+    , noPrereq
     , nodefaults
     , normalCommand
     , withStdOpts
@@ -127,7 +128,7 @@ help = DarcsCommand
     , commandExtraArgs = -1
     , commandExtraArgHelp = ["[<DARCS_COMMAND> [DARCS_SUBCOMMAND]]  "]
     , commandCommand = \ x y z -> helpCmd x y z >> exitSuccess
-    , commandPrereq = \_ -> return $ Right ()
+    , commandPrereq = noPrereq
     , commandCompleteArgs = \_ _ -> return . completeArgs
     , commandArgdefaults = nodefaults
     , commandOptions = withStdOpts oid oid
diff --git a/src/Darcs/UI/Commands/Init.hs b/src/Darcs/UI/Commands/Init.hs
index b1e56952..5271e89f 100644
--- a/src/Darcs/UI/Commands/Init.hs
+++ b/src/Darcs/UI/Commands/Init.hs
@@ -30,6 +30,7 @@ import Darcs.UI.Commands
     , putFinished
     , withStdOpts
     , putWarning
+    , noPrereq
     )
 import Darcs.UI.Commands.Util ( commonHelpWithPrefsTemplates )
 import Darcs.UI.Completion ( noArgs )
@@ -91,7 +92,7 @@ initialize = DarcsCommand
     , commandDescription = initializeDescription
     , commandExtraArgs = -1
     , commandExtraArgHelp = ["[<DIRECTORY>]"]
-    , commandPrereq = \_ -> return $ Right ()
+    , commandPrereq = noPrereq
     , commandCommand = initializeCmd
     , commandCompleteArgs = noArgs
     , commandArgdefaults = nodefaults
diff --git a/src/Darcs/UI/Commands/Log.hs b/src/Darcs/UI/Commands/Log.hs
index 56a1383f..1b5cbbc5 100644
--- a/src/Darcs/UI/Commands/Log.hs
+++ b/src/Darcs/UI/Commands/Log.hs
@@ -62,16 +62,21 @@ import Darcs.Repository ( PatchInfoAnd,
                           withRepoLockCanFail )
 import Darcs.Util.Lock ( withTempDir )
 import Darcs.Patch.Set ( PatchSet, patchSet2RL, Origin )
-import Darcs.Patch.Format ( PatchListFormat )
-import Darcs.Patch.Info ( toXml, toXmlShort, showPatchInfo, displayPatchInfo, PatchInfo )
-import Darcs.Patch.Ident ( PatchId )
+import Darcs.Patch.Format ( FormatPatch(..) )
+import Darcs.Patch.Info
+    ( PatchInfo
+    , showPatchInfo
+    , formatPatchInfo
+    , toXml
+    , toXmlShort
+    )
 import Darcs.Patch.Invertible ( mkInvertible )
 import Darcs.Patch.Depends ( contextPatches )
-import Darcs.Patch.Show ( ShowPatch, ShowPatchFor(..) )
+import Darcs.Patch.Show ( ShowPatch )
 import Darcs.Patch.TouchesFiles ( lookTouch )
 import Darcs.Patch.Apply ( ApplyState )
 import Darcs.Patch ( PrimPatchBase(..), invert, xmlSummary, description,
-                     effectOnPaths, listTouchedFiles, showPatch )
+                     effectOnPaths, listTouchedFiles )
 import Darcs.Patch.Named ( HasDeps, getdeps )
 import Darcs.Patch.Prim.Class ( PrimDetails )
 import Darcs.Patch.Summary ( Summary )
@@ -88,6 +93,8 @@ import Darcs.Patch.Match
     , matchAPatch
     , haveNonrangeMatch
     )
+
+import qualified Darcs.Util.Format as F
 import Darcs.Util.Printer
     ( Doc
     , ($$)
@@ -262,8 +269,7 @@ mkLogInfo ps = LogInfo (map (,[]) ps) [] Nothing
 logInfoFL :: FL p wX wY -> LogInfo p
 logInfoFL = mkLogInfo . mapFL Sealed2
 
-matchNonrange :: (Matchable p, PatchId p ~ PatchInfo)
-              => [MatchFlag] -> RL p wA wB -> [Sealed2 p]
+matchNonrange :: Matchable p => [MatchFlag] -> RL p wA wB -> [Sealed2 p]
 matchNonrange matchFlags
   | haveNonrangeMatch matchFlags = filterRL (matchAPatch matchFlags)
   | otherwise = mapRL Sealed2
@@ -346,7 +352,7 @@ filterPatchesByNames maxcount paths patches = removeNonRenames $
                   case hopefullyM hp of
                     Nothing -> do
                         let err = text "Can't find patches prior to:"
-                                  $$ displayPatchInfo (info hp)
+                                  $$ showPatchInfo (info hp)
                         return (LogInfo [] renames (Just err))
                     Just p ->
                         case lookTouch (Just renames) fs (invert (mkInvertible p)) of
@@ -364,7 +370,7 @@ filterPatchesByNames maxcount paths patches = removeNonRenames $
                                 filterPatchesByNamesM fs' ps
 
 changelog :: forall p wStart wX
-           . ( ShowPatch p, PatchListFormat p
+           . ( ShowPatch p, FormatPatch p
              , Summary p, HasDeps p, PrimDetails (PrimOf p)
              )
           => [DarcsFlag] -> RL (PatchInfoAndG p) wStart wX
@@ -383,7 +389,7 @@ changelog opts patches li
           change_with_summary (Sealed2 hp)
             | Just p <- hopefullyM hp =
               if O.changesFormat ? opts == Just O.MachineReadable
-                then showPatch ForStorage p
+                then F.toDoc $ formatPatch p
                 else showFriendly (verbosity ? opts) (O.withSummary ? opts) p
             | otherwise = description hp $$ indent (text "[this patch is unavailable]")
 
@@ -444,9 +450,8 @@ logContext opts = do
   let repodir = fromMaybe "." $ getRepourl opts
   withRepositoryLocation (useCache ? opts) repodir $ RepoJob $ \repository -> do
       (_ :> ps) <- contextPatches `fmap` readPatches repository
-      let header = text "\nContext:\n"
-      viewDocWith simplePrinters $ vsep
-          (header : mapRL (showPatchInfo ForStorage . info) ps)
+      let header = F.ascii "\nContext:\n"
+      F.putFormat $ F.vsep (header : mapRL (formatPatchInfo . info) ps)
 
 -- | changes is an alias for log
 changes :: DarcsCommand
diff --git a/src/Darcs/UI/Commands/MarkConflicts.hs b/src/Darcs/UI/Commands/MarkConflicts.hs
index ed1f3d21..99129042 100644
--- a/src/Darcs/UI/Commands/MarkConflicts.hs
+++ b/src/Darcs/UI/Commands/MarkConflicts.hs
@@ -200,7 +200,7 @@ markconflictsCmd fps opts args = do
     let post_pending_affected_paths = forward_renames <$> affected_paths
     putInfo opts $ "Marking conflicts in:" <+> showPathSet post_pending_affected_paths <> "."
 
-    debugDocLn $ "::: res = " $$ vsep (mapFL displayPatch res)
+    debugDocLn $ "::: res = " $$ vsep (mapFL showPatch res)
     when (O.yes (dryRun ? opts)) $ do
         putInfo opts $ "Conflicts will not be marked: this is a dry run."
         exitSuccess
diff --git a/src/Darcs/UI/Commands/Optimize.hs b/src/Darcs/UI/Commands/Optimize.hs
index fb0ae557..4c8a6183 100644
--- a/src/Darcs/UI/Commands/Optimize.hs
+++ b/src/Darcs/UI/Commands/Optimize.hs
@@ -32,7 +32,7 @@ import System.Directory
     , removeDirectoryRecursive
     , withCurrentDirectory
     )
-import Darcs.UI.Commands ( DarcsCommand(..), nodefaults
+import Darcs.UI.Commands ( DarcsCommand(..), nodefaults, noPrereq
                          , amInHashedRepository, amInRepository, putInfo
                          , normalCommand, withStdOpts )
 import Darcs.UI.Completion ( noArgs )
@@ -46,6 +46,7 @@ import Darcs.Repository
     , readPatches
     , reorderInventory
     , cleanRepository
+    , writePristine
     )
 import Darcs.Repository.Job ( withOldRepoLock )
 import Darcs.Repository.Traverse ( specialPatches )
@@ -62,7 +63,6 @@ import Darcs.Repository.Paths
     , patchesDirPath
     , pristineDir
     , pristineDirPath
-    , tentativePristinePath
     )
 import Darcs.Repository.Packs ( createPacks )
 import Darcs.Patch.Witnesses.Ordered ( lengthRL )
@@ -81,7 +81,6 @@ import Darcs.Util.Lock
     , gzWriteAtomicFilePS
     , writeAtomicFilePS
     , removeFileMayNotExist
-    , writeBinFile
     )
 import Darcs.Util.File ( doesDirectoryReallyExist )
 import Darcs.Util.Exception ( catchall )
@@ -121,7 +120,7 @@ import Darcs.Repository.Hashed
     ( writeTentativeInventory
     , finalizeTentativeChanges
     )
-import Darcs.Repository.InternalTypes ( repoCache, unsafeCoerceR )
+import Darcs.Repository.InternalTypes ( unsafeCoerceR )
 import Darcs.Repository.Pristine
     ( applyToTentativePristine
     )
@@ -135,7 +134,6 @@ import Darcs.Util.Tree
     )
 import Darcs.Util.Path ( AbsolutePath, realPath, toFilePath )
 import Darcs.Util.Tree.Plain( readPlainTree )
-import Darcs.Util.Tree.Hashed ( writeDarcsHashed )
 
 optimizeDescription :: String
 optimizeDescription = "Optimize the repository."
@@ -471,8 +469,7 @@ actuallyUpgradeFormat _opts _repository = do
   let patchesToApply = progressFL "Applying patch" $ patchSet2FL patches'
   createDirectoryIfMissing False pristineDirPath
   -- We ignore the returned root hash, we don't use it.
-  _ <- writeDarcsHashed emptyTree (repoCache _repository)
-  writeBinFile tentativePristinePath ""
+  _ <- writePristine _repository emptyTree
   -- we must coerce here because we just emptied out pristine
   applyToTentativePristine (unsafeCoerceR _repository) (mkInvertible patchesToApply)
   -- now make it official
@@ -547,7 +544,7 @@ optimizeGlobalCache = common
     , commandHelp = optimizeHelpGlobalCache
     , commandDescription = "Garbage collect global cache"
     , commandCommand = optimizeGlobalCacheCmd
-    , commandPrereq = \_ -> return $ Right ()
+    , commandPrereq = noPrereq
     }
 
 optimizeHelpGlobalCache :: Doc
diff --git a/src/Darcs/UI/Commands/Pull.hs b/src/Darcs/UI/Commands/Pull.hs
index f3f6bb8d..ed1bde47 100644
--- a/src/Darcs/UI/Commands/Pull.hs
+++ b/src/Darcs/UI/Commands/Pull.hs
@@ -26,7 +26,7 @@ module Darcs.UI.Commands.Pull ( -- * Commands.
 import Darcs.Prelude
 
 import System.Exit ( exitSuccess )
-import Control.Monad ( when, unless, (>=>) )
+import Control.Monad ( forM, when, unless, (>=>) )
 import Data.List ( nub )
 import Data.Maybe ( fromMaybe )
 import Safe ( headErr, tailErr )
@@ -73,7 +73,7 @@ import Darcs.Patch ( RepoPatch, description )
 import qualified Darcs.Patch.Bundle as Bundle ( makeBundle )
 import Darcs.Patch.Apply( ApplyState )
 import Darcs.Patch.Set ( PatchSet, Origin, emptyPatchSet, SealedPatchSet )
-import Darcs.Patch.Witnesses.Sealed ( Sealed(..), seal )
+import Darcs.Patch.Witnesses.Sealed ( Sealed(..), Sealed2(..), seal )
 import Darcs.Patch.Witnesses.Ordered
     ( (:>)(..), FL(..), Fork(..)
     , mapFL, nullFL, mapFL_FL )
@@ -100,6 +100,7 @@ import Darcs.UI.SelectChanges
     , selectionConfig
     )
 import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions (..) )
+import Darcs.Util.Format ( putFormat )
 import Darcs.Util.Printer
     ( Doc
     , ($$)
@@ -107,12 +108,11 @@ import Darcs.Util.Printer
     , (<+>)
     , formatWords
     , hsep
-    , putDoc
     , quoted
     , text
     , vcat
     )
-import Darcs.Util.Lock ( writeDocBinFile )
+import Darcs.Util.Lock ( writeFormatBinFile )
 import Darcs.Util.Path ( useAbsoluteOrStd, stdOut, AbsolutePath )
 import Darcs.Util.Workaround ( getCurrentDirectory )
 import Darcs.Util.Tree( Tree )
@@ -319,44 +319,40 @@ makeBundle :: forall p wR . (RepoPatch p, ApplyState p ~ Tree)
            -> IO ()
 makeBundle opts (Sealed (Fork common _ to_be_fetched)) =
     do
-      bundle <- Bundle.makeBundle Nothing common $
-                 mapFL_FL hopefully to_be_fetched
+      let bundle = Bundle.makeBundle common $ mapFL_FL hopefully to_be_fetched
       let fname = case to_be_fetched of
                     (x:>:_)-> getUniqueDPatchName $ patchDesc x
                     _ -> error "impossible case"
       o <- fromMaybe (return stdOut) (getOutput opts fname)
-      useAbsoluteOrStd writeDocBinFile putDoc o bundle
+      useAbsoluteOrStd writeFormatBinFile putFormat o bundle
 
-{- Read in the specified pull-from repositories.  Perform
-Intersection, Union, or Complement read.  In patch-theory terms
-(stated in set algebra, where + is union and & is intersection
-and \ is complement):
+{- | Read in the specified pull-from repositories, and depending on whether
+to perform intersection, union, or complement, return two 'PatchSet's: the
+patches we want to pull and the ones we do not want to pull. In set-algebra
+terms (using + for union, & for intersection):
 
-    Union =         ((R1 + R2 + ... + Rn) \ Rc)
-    Intersection =  ((R1 & R2 & ... & Rn) \ Rc)
-    Complement =    (R1 \ Rc) \ ((R2 + R3 + ... + Rn) \ Rc)
+[union]
+    > (R1 + R2 + ... + Rn, {})
+[intersection]
+    > (R1 & R2 & ... & Rn, {})
+[complement]
+    > (R1, R2 + R3 + ... + Rn)
 
-                        where Rc = local repo
-                              R1 = 1st specified pull repo
-                              R2, R3, Rn = other specified pull repo
-
-Since Rc is not provided here yet, the result of readRepos is a
-tuple: the first patchset(s) to be complemented against Rc and then
-the second patchset(s) to be complemented against Rc.
 -}
-
 readRepos :: RepoPatch p
           => Repository rt p wU wR -> [DarcsFlag] -> [String]
           -> IO (SealedPatchSet p Origin,SealedPatchSet p Origin)
 readRepos _ _ [] = error "impossible case"
-readRepos to_repo opts us =
-    do rs <- mapM (\u -> do r <- identifyRepositoryFor Reading to_repo (useCache ? opts) u
-                            ps <- readPatches r
-                            return $ seal ps) us
-       return $ case parseFlags O.repoCombinator opts of
-                  O.Intersection -> (patchSetIntersection rs, seal emptyPatchSet)
-                  O.Complement -> (headErr rs, patchSetUnion $ tailErr rs)
-                  O.Union -> (patchSetUnion rs, seal emptyPatchSet)
+readRepos to_repo opts locations = do
+  pss <-
+    forM locations $ \loc -> do
+      Sealed2 r <- identifyRepositoryFor Reading to_repo (useCache ? opts) loc
+      Sealed <$> readPatches r
+  return $
+    case parseFlags O.repoCombinator opts of
+      O.Intersection -> (patchSetIntersection pss, seal emptyPatchSet)
+      O.Complement -> (headErr pss, patchSetUnion $ tailErr pss)
+      O.Union -> (patchSetUnion pss, seal emptyPatchSet)
 
 pullPatchSelOpts :: [DarcsFlag] -> S.PatchSelectionOptions
 pullPatchSelOpts flags = S.PatchSelectionOptions
diff --git a/src/Darcs/UI/Commands/Push.hs b/src/Darcs/UI/Commands/Push.hs
index ca730ffb..03cbdc06 100644
--- a/src/Darcs/UI/Commands/Push.hs
+++ b/src/Darcs/UI/Commands/Push.hs
@@ -59,16 +59,15 @@ import Darcs.Patch.Apply( ApplyState )
 import Darcs.Patch.Witnesses.Ordered
     ( (:>)(..), RL, FL, nullRL,
     nullFL, reverseFL, mapFL_FL, mapRL )
+import Darcs.Patch.Witnesses.Sealed ( Sealed(..), Sealed2(..) )
 import Darcs.Repository.Prefs
     ( Pref(Defaultrepo, Repos)
     , addRepoSource
     , getPreflist
     )
-import Darcs.UI.External ( signString, darcsProgram
-                         , pipeDoc, pipeDocSSH )
+import Darcs.UI.External ( darcsProgram, pipeFormat, pipeFormatSSH, signFormat )
 import Darcs.Util.Exception ( die )
-import Darcs.Util.URL ( isHttpUrl, isValidLocalPath
-                      , isSshUrl, splitSshUrl, SshFilePath(..) )
+import Darcs.Util.URL ( SshFilePath(..), isHttpUrl, isSshUrl, splitSshUrl )
 import Darcs.Util.Path ( AbsolutePath )
 import Darcs.UI.SelectChanges
     ( WhichChanges(..)
@@ -80,6 +79,7 @@ import Darcs.Patch.Depends ( findCommonWithThem, countUsThem )
 import Darcs.Patch.Bundle ( makeBundle )
 import Darcs.Patch.Show( ShowPatch )
 import Darcs.Patch.Set ( PatchSet, Origin )
+import Darcs.Util.Format ( Format )
 import Darcs.Util.Printer.Color ( ePutDocLn )
 import Darcs.Util.Printer
     ( Doc
@@ -92,7 +92,6 @@ import Darcs.Util.Printer
     , text
     , vcat
     )
-import Darcs.UI.Email ( makeEmail )
 import Darcs.Util.English (englishNum, Noun(..))
 import Darcs.Util.Workaround ( getCurrentDirectory )
 import Darcs.Util.Tree( Tree )
@@ -176,12 +175,8 @@ pushCmd (_, o) opts [unfixedrepodir] = do
   when (repodir == here) $ die "Cannot push from repository to itself."
   bundle <-
     withRepository (useCache ? opts) $ RepoJob $ prepareBundle opts repodir
-  sbundle <- signString (O.sign ? opts) bundle
-  let body =
-        if isValidLocalPath repodir
-          then sbundle
-          else makeEmail repodir [] Nothing Nothing sbundle Nothing
-  rval <- remoteApply opts repodir body
+  sbundle <- signFormat (O.sign ? opts) bundle
+  rval <- remoteApply opts repodir sbundle
   case rval of
     ExitFailure ec -> do
       ePutDocLn (text "Apply failed!")
@@ -191,13 +186,15 @@ pushCmd _ _ [] = die "No default repository to push to, please specify one."
 pushCmd _ _ _ = die "Cannot push to more than one repo."
 
 prepareBundle :: (RepoPatch p, ApplyState p ~ Tree)
-              => [DarcsFlag] -> String -> Repository rt p wU wR -> IO Doc
+              => [DarcsFlag] -> String -> Repository rt p wU wR -> IO Format
 prepareBundle opts repodir repository = do
   old_default <- getPreflist Defaultrepo
   when (old_default == [repodir]) $
        let pushing = if dryRun ? opts == YesDryRun then "Would push" else "Pushing"
        in  putInfo opts $ text pushing <+> "to" <+> quoted repodir <> "..."
-  them <- identifyRepositoryFor Writing repository (useCache ? opts) repodir >>= readPatches
+  Sealed them <- do
+    Sealed2 r <- identifyRepositoryFor Writing repository (useCache ? opts) repodir
+    Sealed <$> readPatches r
   addRepoSource repodir (dryRun ? opts) (setDefault False opts)
       (O.inheritDefault ? opts) (isInteractive True opts)
   us <- readPatches repository
@@ -227,7 +224,7 @@ prePushChatter opts us only_us them = do
 bundlePatches :: (RepoPatch p, ApplyState p ~ Tree)
               => [DarcsFlag] -> PatchSet p wA wZ
               -> (FL (PatchInfoAnd p) :> t) wZ wW
-              -> IO Doc
+              -> IO Format
 bundlePatches opts common (to_be_pushed :> _) =
     do
       setEnvDarcsPatches to_be_pushed
@@ -242,7 +239,7 @@ bundlePatches opts common (to_be_pushed :> _) =
           putInfo opts $
             text "You don't want to push any patches, and that's fine with me!"
           exitSuccess
-      makeBundle Nothing common (mapFL_FL hopefully to_be_pushed)
+      return $ makeBundle common (mapFL_FL hopefully to_be_pushed)
 
 checkOptionsSanity :: [DarcsFlag] -> String -> IO ()
 checkOptionsSanity opts repodir =
@@ -265,7 +262,7 @@ pushPatchSelOpts flags = S.PatchSelectionOptions
     , S.withSummary = O.withSummary ? flags
     }
 
-remoteApply :: [DarcsFlag] -> String -> Doc -> IO ExitCode
+remoteApply :: [DarcsFlag] -> String -> Format -> IO ExitCode
 remoteApply opts repodir bundle
     = case applyAs ? opts of
         Nothing
@@ -275,18 +272,18 @@ remoteApply opts repodir bundle
             | isSshUrl repodir -> applyViaSshAndSudo opts (splitSshUrl repodir) un bundle
             | otherwise -> applyViaSudo opts un repodir bundle
 
-applyViaSudo :: [DarcsFlag] -> String -> String -> Doc -> IO ExitCode
+applyViaSudo :: [DarcsFlag] -> String -> String -> Format -> IO ExitCode
 applyViaSudo opts user repo bundle =
   darcsProgram >>= \darcs ->
-    pipeDoc "sudo" ("-u" : user : darcs : darcsArgs opts repo) bundle
+    pipeFormat "sudo" ("-u" : user : darcs : darcsArgs opts repo) bundle
 
-applyViaLocal :: [DarcsFlag] -> String -> Doc -> IO ExitCode
+applyViaLocal :: [DarcsFlag] -> String -> Format -> IO ExitCode
 applyViaLocal opts repo bundle =
-  darcsProgram >>= \darcs -> pipeDoc darcs (darcsArgs opts repo) bundle
+  darcsProgram >>= \darcs -> pipeFormat darcs (darcsArgs opts repo) bundle
 
-applyViaSsh :: [DarcsFlag] -> SshFilePath -> Doc -> IO ExitCode
+applyViaSsh :: [DarcsFlag] -> SshFilePath -> Format -> IO ExitCode
 applyViaSsh opts repo =
-  pipeDocSSH
+  pipeFormatSSH
     (O.compress ? opts)
     repo
     [ unwords $
@@ -294,9 +291,9 @@ applyViaSsh opts repo =
         darcsArgs opts (shellQuote (sshRepo repo))
     ]
 
-applyViaSshAndSudo :: [DarcsFlag] -> SshFilePath -> String -> Doc -> IO ExitCode
+applyViaSshAndSudo :: [DarcsFlag] -> SshFilePath -> String -> Format -> IO ExitCode
 applyViaSshAndSudo opts repo username =
-  pipeDocSSH
+  pipeFormatSSH
     (O.compress ? opts)
     repo
     [ unwords $
diff --git a/src/Darcs/UI/Commands/Rebase.hs b/src/Darcs/UI/Commands/Rebase.hs
index 0f38cbdd..bba94edc 100644
--- a/src/Darcs/UI/Commands/Rebase.hs
+++ b/src/Darcs/UI/Commands/Rebase.hs
@@ -45,7 +45,7 @@ import Darcs.UI.PatchHeader
 import Darcs.Repository
     ( Repository, RepoJob(..), AccessType(..), withRepoLock, withRepository
     , tentativelyAddPatches, finalizeRepositoryChanges
-    , tentativelyRemovePatches, readPatches
+    , tentativelyRemovePatches, readPatches, readUnrecorded
     , setTentativePending, unrecordedChanges, applyToWorking
     )
 import Darcs.Repository.Flags
@@ -71,7 +71,7 @@ import Darcs.Repository.Transaction ( upgradeOldStyleRebase )
 import Darcs.Patch ( PrimOf, invert, effect, commute, RepoPatch )
 import Darcs.Patch.Apply ( ApplyState )
 import Darcs.Patch.CommuteFn ( commuterFLId, commuterIdFL )
-import Darcs.Patch.Info ( displayPatchInfo, piName )
+import Darcs.Patch.Info ( showPatchInfo, piName )
 import Darcs.Patch.Match ( secondMatch, splitSecondFL )
 import Darcs.Patch.Merge ( cleanMerge )
 import Darcs.Patch.Named ( fmapFL_Named, patchcontents, patch2patchinfo )
@@ -83,11 +83,13 @@ import Darcs.Patch.Rebase.Change
     , partitionUnconflicted
     , WithDroppedDeps(..), WDDNamed, commuterIdWDD
     , simplifyPush, simplifyPushes
+    , forceCommuteRebaseChange
     )
 import Darcs.Patch.Rebase.Fixup
     ( RebaseFixup(..)
     , commuteNamedFixup
     , flToNamesPrims
+    , primNamedToFixups
     )
 import Darcs.Patch.Rebase.Name ( RebaseName(..), commuteNameNamed )
 import Darcs.Patch.Rebase.Suspended ( Suspended(..), addToEditsToSuspended )
@@ -129,7 +131,7 @@ import Darcs.Patch.Witnesses.Ordered
     , (+>>+)
     )
 import Darcs.Patch.Witnesses.Sealed
-    ( Sealed(..), seal, unseal
+    ( Sealed(..), seal, unseal, mapSeal
     , Sealed2(..)
     )
 import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
@@ -152,7 +154,7 @@ import Darcs.Util.SignalHandler ( withSignalsBlocked )
 import Darcs.Util.Tree ( Tree )
 
 import Control.Exception ( throwIO, try )
-import Control.Monad ( unless, when, void )
+import Control.Monad ( mplus, unless, when, void )
 import Control.Monad.Trans ( liftIO )
 import System.Exit ( ExitCode(ExitSuccess), exitSuccess )
 
@@ -438,6 +440,8 @@ unsuspendCmd cmd reifyFixups _ opts _args =
     _repository <-
       tentativelyAddPatches _repository NoUpdatePending unsuspended_ps
     let effect_unsuspended = concatFL (mapFL_FL effect unsuspended_ps)
+    -- FIXME issue2272: ask the user if we should revert the
+    -- conflicting changes for them, as we do for suspend and obliterate
     case cleanMerge (effect_unsuspended :\/: unrec) of
       Nothing ->
         fail $ "Can't "++cmd++" because there are conflicting unrecorded changes."
@@ -474,9 +478,9 @@ unsuspendCmd cmd reifyFixups _ opts _args =
                       putDocLnWith fancyPrinters $
                         redText ("Dropping the following explicit " ++
                           englishNum (length deps) (Noun "dependency") ":") $$
-                        displayPatchInfo (patch2patchinfo (wddPatch p)) $$
+                        showPatchInfo (patch2patchinfo (wddPatch p)) $$
                         indent 1 (redText "depended on:") $$
-                        indent 2 (vcat (map displayPatchInfo deps))
+                        indent 2 (vcat (map showPatchInfo deps))
 
               -- TODO should catch logfiles (fst value from updatePatchHeader)
               -- and clean them up as in AmendRecord
@@ -525,7 +529,7 @@ inject = DarcsCommand
     , commandOptions = injectOpts
     }
   where
-    injectBasicOpts = O.keepDate ^ O.author ^ O.diffAlgorithm
+    injectBasicOpts = O.keepDate ^ O.author ^ O.diffAlgorithm ^ O.withSummary
     injectOpts = injectBasicOpts `withStdOpts` O.umask
     injectDescription =
       "Merge a change from the fixups of a patch into the patch itself."
@@ -600,7 +604,7 @@ obliterate = DarcsCommand
     , commandOptions = obliterateOpts
     }
   where
-    obliterateBasicOpts = O.diffAlgorithm
+    obliterateBasicOpts = O.diffAlgorithm ^ O.withSummary
     obliterateOpts = obliterateBasicOpts `withStdOpts` O.umask
     obliterateDescription =
       "Obliterate a patch that is currently suspended."
@@ -642,12 +646,31 @@ obliterateOne
   -> RebaseChange prim wX wY
   -> Sealed (FL (RebaseChange prim) wY)
   -> Sealed (FL (RebaseChange prim) wX)
-obliterateOne da (RC fs e) =
-  unseal (simplifyPushes da fs) .
-  -- since Named doesn't have any witness context for the
-  -- patch names, the AddName here will be inferred to be wX wX
-  unseal (simplifyPush da (NameFixup (AddName (patch2patchinfo e)))) .
-  unseal (simplifyPushes da (mapFL_FL PrimFixup (patchcontents e)))
+obliterateOne da rc = unseal (simplifyPushes da (rcToFixups rc))
+
+rcToFixups :: RebaseChange prim wX wY -> FL (RebaseFixup prim) wX wY
+rcToFixups (RC fs e) = fs +>+ primNamedToFixups e
+
+forceCommute
+  :: PrimPatch prim
+  => O.DiffAlgorithm
+  -> RebaseChange prim wX wY
+  -> RebaseChange prim wY wZ
+  -> Sealed (FL (RebaseChange prim) wZ)
+  -> Maybe (Sealed (FL (RebaseChange prim) wX))
+forceCommute da rc1 rc2 (Sealed rcs) =
+  do
+    rc2' :> rc1' <- commute (rc1 :> rc2)
+    return $ Sealed (rc2' :>: rc1' :>: rcs)
+  `mplus`
+  do
+    RC fs2' e2' :> RC fs1' e1' <- forceCommuteRebaseChange (rc1 :> rc2)
+    return $
+      unseal (simplifyPushes da fs2') $
+      mapSeal (RC NilFL e2' :>:) $
+      unseal (simplifyPushes da fs1') $
+      mapSeal (RC NilFL e1' :>:) $
+      Sealed rcs
 
 edit :: DarcsCommand
 edit = DarcsCommand
@@ -705,6 +728,13 @@ interactiveEdit opts redos s@EditState{..} undos =
   -- invariants:
   --  * the "todo" patches are empty only if the "done" patches are; formally:
   --      case patches of Sealed (done :> todo) -> nullFL todo ==> nullRL done
+  -- TODO
+  --  * Commuting of patches: move current patch forward/backward in the
+  --    sequence; if they don't commute, do we want to force-commte them?
+  --    Or is that an extra command?
+  --  * Injecting fixups is simple but often insufficient i.e. not what we want.
+  --    Instead we could offer "in-place" conflict resolution: present the
+  --    conflict as markup in a text editor (like with hunk editing).
   case patches of
     Sealed (_ :> NilFL) -> prompt
     Sealed (_ :> p :>: _) -> defaultPrintFriendly p >> prompt
@@ -767,8 +797,9 @@ interactiveEdit opts redos s@EditState{..} undos =
               , PromptChoice 'e' True reword "edit name and/or long comment (log)"
               , PromptChoice 's' (index > 0) squash "squash with previous patch"
               , PromptChoice 'i' can_inject inject' "inject fixups"
+              , PromptChoice 'c' (index > 0) comm "(force-)commute with previous patch)"
               -- TODO
-              -- , PromptChoice 'c' True ??? "select individual changes for editing"
+              -- , PromptChoice '???' True ??? "select individual changes for editing"
               ]
             choicesView =
               [ PromptChoice 'v' True view "view this patch in full"
@@ -811,6 +842,19 @@ interactiveEdit opts redos s@EditState{..} undos =
             reword = do
               Sealed todo'' <- rewordOne da p todo'
               edit' "reword" s { patches = Sealed (done :> todo'') }
+            comm = do
+              case done of
+                NilRL -> error "impossible"
+                done' :<: q ->
+                  case forceCommute da q p (Sealed todo') of
+                    Just (Sealed todo'') ->
+                      edit' "commute" s
+                        { patches = Sealed (done' :> todo'')
+                        , index = index - 1
+                        }
+                    Nothing -> do
+                      putStrLn "Failed to commute fixups backward, try inject first."
+                      prompt
             squash =
               case done of
                 NilRL -> error "impossible"
@@ -831,6 +875,9 @@ interactiveEdit opts redos s@EditState{..} undos =
 
             -- viewing
             view = printContent p >> prompt
+            -- FIXME when we quit the pager hitting 'q', this leaks
+            -- as the new command key, quitting the whole command.
+            -- Why does this happen here but not in other commands?
             pager = printContentWithPager p >> prompt
             display = defaultPrintFriendly p >> prompt
             summary = printSummary p >> prompt
@@ -870,7 +917,7 @@ squashOne da (RC fs1 e1) (RC fs2 e2) rest = do
       Sealed rest' -> simplifyPushes da (fs1 +>+ fs2') (RC NilFL e1'' :>: rest')
 
 rewordOne
-  :: (PrimPatch prim, ApplyState prim ~ Tree)
+  :: PrimPatch prim
   => O.DiffAlgorithm
   -> RebaseChange prim wX wY
   -> FL (RebaseChange prim) wY wZ
@@ -997,22 +1044,28 @@ applyPatchesForRebaseCmd cmdName opts _repository (Fork common us' to_be_applied
     -- the new rebase patch containing the suspended patches is now in the repo
     -- and the suspended patches have been removed
 
-    -- We must apply the suspend to working because tentativelyMergePatches
-    -- calls unrecordedChanges. We also have to update the index, since that is
-    -- used to filter the working tree (unless --ignore-times is in effect).
-    updateIndex _repository
-    _repository <- withSignalsBlocked $ do
+    -- We must apply the suspend to working so that tentativelyMergePatches
+    -- and readUnrecorded below see the intermediate working tree.
+    _repository <-
+      withSignalsBlocked $
         applyToWorking _repository (verbosity ? opts) toWorking
 
-    Sealed pw <-
-        tentativelyMergePatches
+    -- For the same reason we have to update the index here, since both
+    -- readUnrecorded and unrecordedChanges filter the working tree using the
+    -- index (unless --ignore-times is in effect).
+    when (O.yes (O.useIndex ? opts)) $ updateIndex _repository
+
+    -- this is the working tree without un-added items (but with pending adds)
+    old_working <- readUnrecorded _repository (O.useIndex ? opts) Nothing
+
+    pw <- tentativelyMergePatches
             _repository cmdName
             (allowConflicts opts)
             (wantGuiPause opts)
             (reorder ? opts) (diffingOpts opts)
             (Fork common (usOk +>+ usKeep) to_be_applied)
 
-    applyPatchesFinish cmdName opts _repository pw (nullFL to_be_applied)
+    applyPatchesFinish cmdName opts _repository old_working pw (nullFL to_be_applied)
 
 applyPatchSelOpts :: S.PatchSelectionOptions
 applyPatchSelOpts = S.PatchSelectionOptions
diff --git a/src/Darcs/UI/Commands/Record.hs b/src/Darcs/UI/Commands/Record.hs
index eb078215..5ed7754d 100644
--- a/src/Darcs/UI/Commands/Record.hs
+++ b/src/Darcs/UI/Commands/Record.hs
@@ -49,7 +49,7 @@ import Darcs.Repository
     , readPristine
     , readPatches
     , tentativelyAddPatch
-    , tentativelyRemoveFromPW
+    , tentativelyRemoveFromPending
     , withRepoLock
     )
 import Darcs.Repository.Flags ( UpdatePending(..) )
@@ -306,7 +306,7 @@ doActualRecord :: (RepoPatch p, ApplyState p ~ Tree)
                -> [PatchInfo] -> FL (PrimOf p) wR wX
                -> (FL (PrimOf p) :> FL (PrimOf p)) wR wU -> IO ()
 doActualRecord _repository cfg name date my_author my_log logf deps chs
-      (pending :> working) = do
+      (pending :> _) = do
     debugMessage "Writing the patch file..."
     myinfo <- patchinfo date name my_author my_log
     let mypatch = infopatch myinfo $ progressFL "Writing changes" chs
@@ -317,7 +317,7 @@ doActualRecord _repository cfg name date my_author my_log logf deps chs
     testTentativeAndMaybeExit tp cfg
       ("you have a bad patch: '" ++ name ++ "'")
       "record it" (Just failuremessage)
-    tentativelyRemoveFromPW _repository chs pending working
+    tentativelyRemoveFromPending _repository chs pending
     _repository <-
       finalizeRepositoryChanges _repository (O.dryRun ? cfg)
       `clarifyErrors` failuremessage
diff --git a/src/Darcs/UI/Commands/Remove.hs b/src/Darcs/UI/Commands/Remove.hs
index d8b469d2..3718c7d3 100644
--- a/src/Darcs/UI/Commands/Remove.hs
+++ b/src/Darcs/UI/Commands/Remove.hs
@@ -40,17 +40,17 @@ import Darcs.Repository
     , RepoJob(..)
     , addToPending
     , finalizeRepositoryChanges
+    , readPristine
     , readPristineAndPending
     , readUnrecorded
     )
 import Darcs.Repository.Diff( treeDiff )
 import Darcs.Repository.State ( restrictSubpaths, applyTreeFilter )
 
-import Darcs.Patch ( RepoPatch, PrimOf, PrimPatch, adddir, rmdir, addfile, rmfile,
-                     listTouchedFiles )
+import Darcs.Patch ( RepoPatch, PrimOf, PrimPatch, listTouchedFiles )
 import Darcs.Patch.Apply( ApplyState )
 import Darcs.Patch.Witnesses.Ordered ( FL(..), concatGapsFL, nullFL )
-import Darcs.Patch.Witnesses.Sealed ( Sealed(..), Gap(..), FreeLeft, unFreeLeft )
+import Darcs.Patch.Witnesses.Sealed ( Sealed(..), FreeLeft, unFreeLeft )
 import Darcs.Repository.Prefs ( filetypeFunction, FileType )
 import Darcs.Util.Tree( Tree, TreeItem(..), explodePaths )
 import qualified Darcs.Util.Tree as T ( find, modifyTree, expand, list )
@@ -99,15 +99,7 @@ removeCmd fps opts relargs = do
         fail "Cannot remove a repository's root directory!"
     withRepoLock (useCache ? opts) (umask ? opts) $
       RepoJob $ \repository -> do
-        pathFilter <- restrictSubpaths repository paths
-        pristine <-
-            T.expand =<<
-            applyTreeFilter pathFilter <$> readPristineAndPending repository
-        let exploded_paths =
-              (if parseFlags O.recursive opts
-                then reverse . explodePaths pristine
-                else id) paths
-        Sealed p <- makeRemovePatch opts repository exploded_paths pristine
+        Sealed p <- makeRemovePatch opts repository paths
         when (nullFL p && not (null paths)) $
             fail "No files were removed."
         addToPending repository (diffingOpts opts) p
@@ -116,57 +108,79 @@ removeCmd fps opts relargs = do
         putInfo opts $ vcat $ map text $ ["Will stop tracking:"] ++
             map displayPath (listTouchedFiles p)
 
--- | makeRemovePatch builds a list of patches to remove the given filepaths.
---   This function does not recursively process directories. The 'Recursive'
---   flag should be handled by the caller by adding all offspring of a directory
---   to the files list.
-makeRemovePatch :: (RepoPatch p, ApplyState p ~ Tree)
-                => [DarcsFlag] -> Repository rt p wU wR
-                -> [AnchoredPath] -> Tree IO -> IO (Sealed (FL (PrimOf p) wU))
-makeRemovePatch opts repository files pristine = do
-  unrecorded <- readUnrecorded repository (O.useIndex ? opts) $ Just files
+-- | Build a list of patches to remove the given filepaths, possibly
+-- recursively.
+makeRemovePatch
+  :: (RepoPatch p, ApplyState p ~ Tree)
+  => [DarcsFlag]
+  -> Repository rt p wU wR
+  -> [AnchoredPath]
+  -> IO (Sealed (FL (PrimOf p) wU))
+makeRemovePatch opts repository paths = do
+  pathFilter <- restrictSubpaths repository paths
+  recorded <- T.expand =<< applyTreeFilter pathFilter <$> readPristine repository
+  pending <-
+    T.expand =<< applyTreeFilter pathFilter <$> readPristineAndPending repository
+  let exploded_paths =
+        (if parseFlags O.recursive opts
+          then reverse . explodePaths pending
+          else id) paths
+  unrecorded <- readUnrecorded repository (O.useIndex ? opts) $ Just exploded_paths
   ftf <- filetypeFunction
-  result <- foldM removeOnePath (ftf, pristine, unrecorded, []) files
+  result <-
+    foldM removeOnePath (ftf, recorded, pending, unrecorded, []) exploded_paths
   case result of
-    (_, _, _, patches) ->
+    (_, _, _, _, patches) ->
       return $
       unFreeLeft $ concatGapsFL $ reverse patches
   where
-    removeOnePath (ftf, recorded, unrecorded, patches) f = do
-      let recorded' = T.modifyTree recorded f Nothing
+    removeOnePath (ftf, recorded, pending, unrecorded, patches) f = do
+      let pending' = T.modifyTree pending f Nothing
           unrecorded' = T.modifyTree unrecorded f Nothing
-      local <- makeRemoveGap opts ftf recorded unrecorded unrecorded' f
+      local <-
+        makeRemoveGap opts ftf recorded pending pending' unrecorded unrecorded' f
       -- we can tell if the remove succeeded by looking if local is
       -- empty. If the remove succeeded, we should pass on updated
-      -- recorded and unrecorded that reflect the removal
+      -- pending and unrecorded that reflect the removal
       return $
         case local of
-          Just gap -> (ftf, recorded', unrecorded', gap : patches)
-          _ -> (ftf, recorded, unrecorded, patches)
-
--- | Takes a file path and returns the FL of patches to remove that, wrapped in
---   a 'Gap'.
---   Returns 'Nothing' in case the path cannot be removed (if it is not tracked,
---   or if it's a directory and it's not tracked).
---   The three 'Tree' arguments are the recorded state, the unrecorded state
---   excluding the removal of this file, and the unrecorded state including the
---   removal of this file.
-makeRemoveGap :: PrimPatch prim => [DarcsFlag] -> (FilePath -> FileType)
-                -> Tree IO -> Tree IO -> Tree IO -> AnchoredPath
-                -> IO (Maybe (FreeLeft (FL prim)))
-makeRemoveGap opts ftf recorded unrecorded unrecorded' path =
-    case (T.find recorded path, T.find unrecorded path) of
-        (Just (SubTree _), Just (SubTree unrecordedChildren)) ->
-            if not $ null (T.list unrecordedChildren)
-              then skipAndWarn "it is not empty"
-              else return $ Just $ freeGap (rmdir path :>: NilFL)
-        (Just (File _), Just (File _)) -> do
-            Just `fmap` treeDiff (diffAlgorithm ? opts) ftf unrecorded unrecorded'
-        (Just (File _), _) ->
-            return $ Just $ freeGap (addfile path :>: rmfile path :>: NilFL)
-        (Just (SubTree _), _) ->
-            return  $ Just $ freeGap (adddir path :>: rmdir path :>: NilFL)
-        (_, _) -> skipAndWarn "it is not tracked by darcs"
+          Just gap -> (ftf, recorded, pending', unrecorded', gap : patches)
+          _ -> (ftf, recorded, pending, unrecorded, patches)
+
+-- | Return the FL of patches to remove the item at the given path, wrapped in
+-- a 'Gap'. Returns 'Nothing' in case the path cannot be removed (if it is not
+-- tracked (i.e. in the pending state), or if it's a directory and is not empty).
+makeRemoveGap
+  :: PrimPatch prim
+  => [DarcsFlag]
+  -> (FilePath -> FileType)
+  -> Tree IO      -- ^ recorded state
+  -> Tree IO      -- ^ pending state
+  -> Tree IO      -- ^ pending state with item removed
+  -> Tree IO      -- ^ unrecorded state
+  -> Tree IO      -- ^ unrecorded state with item removed
+  -> AnchoredPath -- ^ path of item
+  -> IO (Maybe (FreeLeft (FL prim)))
+makeRemoveGap opts ftf recorded pending pending' unrecorded unrecorded' path =
+    case (T.find recorded path, T.find pending path, T.find unrecorded path) of
+        (_, Just (SubTree _), Just (SubTree unrecordedChildren))
+            | not $ null (T.list unrecordedChildren) ->
+              skipAndWarn "it is not empty"
+        (Just _, _, Nothing) ->
+            -- Item was already removed in the working tree
+            -- (may or may not be removed in pending).
+            -- Note that a non-empty result means that the item existed after
+            -- pending, but was removed in the working tree. If the file had
+            -- any content, the diff between pending and working has the prims
+            -- that remove the content, but not the actual removal, so our
+            -- removal prim does apply cleanly after working and addToPending
+            -- will take care of commuting the content remove prims into
+            -- pending as well.
+            Just <$> treeDiff (diffAlgorithm ? opts) ftf pending pending'
+        (_, Just _, Just _) ->
+            -- item is present in both pending and working
+            Just <$> treeDiff (diffAlgorithm ? opts) ftf unrecorded unrecorded'
+        _ -> skipAndWarn "it is not tracked by darcs"
   where skipAndWarn reason =
             do putWarning opts . text $ "Can't remove " ++ displayPath path
                                         ++ " (" ++ reason ++ ")"
diff --git a/src/Darcs/UI/Commands/Repair.hs b/src/Darcs/UI/Commands/Repair.hs
index adc95ed3..47574cf1 100644
--- a/src/Darcs/UI/Commands/Repair.hs
+++ b/src/Darcs/UI/Commands/Repair.hs
@@ -52,7 +52,7 @@ import Darcs.Repository
 import Darcs.Repository.Hashed ( writeTentativeInventory )
 import Darcs.Repository.Pending ( setTentativePending )
 
-import Darcs.Patch ( displayPatch )
+import Darcs.Patch ( showPatch )
 import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
 
 import Darcs.Util.Printer ( Doc, text, ($$) )
@@ -120,7 +120,7 @@ repairCmd opts
             putInfo opts "Writing out repaired patches..."
             writeTentativeInventory repo ps
           maybeDo fixedPristine $ \(tree, Sealed diff) -> do
-            putVerbose opts $ "Pristine differences:" $$ displayPatch diff
+            putVerbose opts $ "Pristine differences:" $$ showPatch diff
             putInfo opts "Fixing pristine tree..."
             void $ writePristine repo tree
           maybeDo fixedPending $ \(Sealed pend) -> do
@@ -164,7 +164,7 @@ checkCmd opts = withRepository (useCache ? opts) $ RepoJob $ \repository -> do
     putInfo opts "Found broken patches."
   maybeDo fixedPristine $ \(_, Sealed diff) -> do
     putInfo opts "Found broken pristine tree."
-    putVerbose opts $ "Differences:" $$ displayPatch diff
+    putVerbose opts $ "Differences:" $$ showPatch diff
   maybeDo fixedPending $ \_ ->
     putInfo opts "Found broken pending."
   bad_index <-
diff --git a/src/Darcs/UI/Commands/Replace.hs b/src/Darcs/UI/Commands/Replace.hs
index 34573cb0..9169a041 100644
--- a/src/Darcs/UI/Commands/Replace.hs
+++ b/src/Darcs/UI/Commands/Replace.hs
@@ -78,8 +78,12 @@ replaceHelp = vsep $ map formatWords
     , "each occurrence of the old word is replaced by the new word."
     , "This is intended to provide a clean way to rename a function or"
     , "variable.  Such renamings typically affect lines all through the"
-    , "source code, so a traditional line-based patch would be very likely to"
-    , "conflict with other branches, requiring manual merging."
+    , "source code, so a traditional line-based patch (hunk) would be very"
+    , "likely to conflict with other hunks, requiring manual merging."
+    , "Note that replace patches will cleanly merge with hunks that introduce"
+    , "the old token, even if the original file did not contain any of them."
+    , "(But this does not hold for hunks that introduce the new token, see"
+    , "the section about the --force option below.)"
     ]
   , [ "Files are tokenized according to one simple rule: words are strings of"
     , "valid token characters, and everything between them (punctuation and"
@@ -98,25 +102,18 @@ replaceHelp = vsep $ map formatWords
     , "could be used to match fields in the passwd(5), where records and"
     , "fields are separated by newlines and colons respectively."
     ]
-  , [ "If you choose to use `--token-chars`, you are STRONGLY encouraged to do"
-    , "so consistently.  The consequences of using multiple replace patches"
-    , "with different `--token-chars` arguments on the same file are not well"
-    , "tested nor well understood."
-    ]
   , [ "By default Darcs will refuse to perform a replacement if the new token"
-    , "is already in use, because the replacements would be not be"
-    , "distinguishable from the existing tokens.  This behaviour can be"
-    , "overridden by supplying the `--force` option, but an attempt to `darcs"
-    , "rollback` the resulting patch will affect these existing tokens."
+    , "already occurs as a token in the file.  This behaviour can be overridden"
+    , "by supplying the `--force` option. This will add extra hunk changes before"
+    , "the replace change that rename the new token to the old one. The more"
+    , "often the new token occurs in the file, the less useful a forced replace"
+    , "becomes, so choose with care."
     ]
   , [ "Limitations:"
     ]
   , [ "The tokenizer treats files as byte strings, so it is not possible for"
     , "`--token-chars` to include multi-byte characters, such as the non-ASCII"
-    , "parts of UTF-8.  Similarly, trying to replace a \"high-bit\" character"
-    , "from a unibyte encoding will also result in replacement of the same"
-    , "byte in files with different encodings.  For example, an acute a from"
-    , "ISO 8859-1 will also match an alpha from ISO 8859-7."
+    , "parts of UTF-8 or ISO-8895 encodings."
     ]
   , [ "Due to limitations in the patch file format, `--token-chars` arguments"
     , "cannot contain literal whitespace.  For example, `[^ \\n\\t]` cannot be"
@@ -242,10 +239,8 @@ isTok :: String -> String -> Bool
 isTok _ "" = False
 isTok toks s = all (regChars toks) s
 
--- | This function checks for @--token-chars@ on the command-line. If found,
--- it validates the argument and returns it, without the surrounding square
--- brackets. Otherwise, it returns either 'defaultToks' or 'filenameToks' as
--- explained in 'replaceHelp'.
+-- | This function validates the argument to the --token-chars option and returns
+-- it without the surrounding square brackets.
 --
 -- Note: Limitations in the current replace patch file format prevents tokens
 -- and token-char specifiers from containing any whitespace.
diff --git a/src/Darcs/UI/Commands/Send.hs b/src/Darcs/UI/Commands/Send.hs
index e9a25d30..ebbd40fe 100644
--- a/src/Darcs/UI/Commands/Send.hs
+++ b/src/Darcs/UI/Commands/Send.hs
@@ -74,15 +74,14 @@ import Darcs.Repository
     , withRepository
     , RepoJob(..)
     , readPatches
-    , readPristine
     , prefsUrl )
 import Darcs.Patch.Set ( Origin )
 import Darcs.Patch.Apply( ApplyState )
-import Darcs.Patch ( RepoPatch, description, applyToTree, effect, invert )
-import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
+import Darcs.Patch ( RepoPatch, description )
+import Darcs.Patch.Witnesses.Sealed ( Sealed(..), Sealed2(..) )
 import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
 import Darcs.Patch.Witnesses.Ordered
-    ( FL(..), (:>)(..), (:\/:)(..),
+    ( FL(..), (:>)(..),
     mapFL, mapFL_FL, lengthFL, nullFL )
 import Darcs.Patch.Bundle
     ( makeBundle
@@ -97,7 +96,7 @@ import Darcs.Repository.Prefs
 import Darcs.Repository.Flags ( DryRun(..) )
 import Darcs.Util.File ( fetchFilePS, Cachable(..) )
 import Darcs.UI.External
-    ( signString
+    ( signFormat
     , sendEmailDoc
     , generateEmail
     , editFile
@@ -126,10 +125,11 @@ import Darcs.UI.Completion ( prefArgs )
 import Darcs.UI.Commands.Util ( getUniqueDPatchName )
 import Darcs.Util.Printer
     ( Doc, formatWords, vsep, text, ($$), (<+>), putDoc, putDocLn
-    , quoted, renderPS, sentence, vcat
+    , quoted, renderPS, vcat
     )
 import Darcs.Util.English ( englishNum, Noun(..) )
 import Darcs.Util.Exception ( catchall )
+import qualified Darcs.Util.Format as F
 import Darcs.Util.Path ( FilePathLike, toFilePath, AbsolutePath, AbsolutePathOrStd,
                         getCurrentDirectory, useAbsoluteOrStd, makeAbsoluteOrStd )
 import Darcs.Util.HTTP ( postUrl )
@@ -212,7 +212,7 @@ sendCmd (_,o) opts [unfixedrepodir] =
         old_default <- getPreflist Defaultrepo
         when (old_default == [repodir]) $
             putInfo opts (creatingPatch repodir)
-        repo <- identifyRepositoryFor Reading repository (useCache ? opts) repodir
+        Sealed2 repo <- identifyRepositoryFor Reading repository (useCache ? opts) repodir
         them <- readPatches repo
         addRepoSource repodir (dryRun ? opts) (setDefault False opts)
           (O.inheritDefault ? opts) (isInteractive True opts)
@@ -231,7 +231,6 @@ sendToThem repo opts wtds their_name them = do
       NilFL -> do putInfo opts nothingSendable
                   exitSuccess
       _     -> putVerbose opts $ selectionIs (mapFL description us')
-  pristine <- readPristine repo
   let direction = if changesReverse ? opts then FirstReversed else First
       selection_config = selectionConfig direction "send" (patchSelOpts opts) Nothing Nothing
   (to_be_sent :> _) <- runSelection us' selection_config
@@ -247,14 +246,15 @@ sendToThem repo opts wtds their_name them = do
       exitSuccess
   setEnvDarcsPatches to_be_sent
 
-  let genFullBundle = prepareBundle opts common  (Right (pristine, us':\/:to_be_sent))
+  let genFullBundle = prepareBundle opts common to_be_sent
   bundle <- if not (minimize ? opts)
              then genFullBundle
              else do putInfo opts "Minimizing context, to send with full context hit ctrl-C..."
                      ( case minContext common to_be_sent of
-                         Sealed (common' :> to_be_sent') -> prepareBundle opts common' (Left to_be_sent') )
+                         Sealed (common' :> to_be_sent') ->
+                            prepareBundle opts common' to_be_sent' )
                      `catchInterrupt` genFullBundle
-  here   <- getCurrentDirectory
+  here <- getCurrentDirectory
   let make_fname (tb:>:_) = getUniqueDPatchName $ patchDesc tb
       make_fname _ = error "impossible case"
   let fname = make_fname to_be_sent
@@ -264,27 +264,20 @@ sendToThem repo opts wtds their_name them = do
                             | not $ null [ p | PostHttp p <- wtds] -> Nothing
                             | otherwise        -> Just (makeAbsoluteOrStd here <$> fname)
   case outname of
-    Just fname' -> fname' >>= \f -> writeBundleToFile opts to_be_sent bundle f wtds their_name
-    Nothing     -> fname >>= \f -> sendBundle opts to_be_sent bundle f wtds their_name
-
-
-prepareBundle :: forall p wX wY wZ. (RepoPatch p, ApplyState p ~ Tree)
-              => [DarcsFlag] -> PatchSet p Origin wZ
-              -> Either (FL (PatchInfoAnd p) wX wY)
-                        (Tree IO, (FL (PatchInfoAnd p) :\/: FL (PatchInfoAnd p)) wX wY)
-              -> IO Doc
-prepareBundle opts common e = do
-  unsig_bundle <-
-     case e of
-       (Right (pristine, us' :\/: to_be_sent)) -> do
-         pristine' <- applyToTree (invert $ effect us') pristine
-         makeBundle (Just pristine')
-                     (unsafeCoerceP common)
-                     (mapFL_FL hopefully to_be_sent)
-       Left to_be_sent -> makeBundle Nothing
-                                      (unsafeCoerceP common)
-                                      (mapFL_FL hopefully to_be_sent)
-  signString (O.sign ? opts) unsig_bundle
+    Just fname' -> fname' >>= \f -> writeBundleToFile opts to_be_sent (F.toDoc bundle) f wtds their_name
+    Nothing     -> fname >>= \f -> sendBundle opts to_be_sent (F.toDoc bundle) f wtds their_name
+
+
+prepareBundle
+  :: forall p wX wY wZ
+   . (RepoPatch p, ApplyState p ~ Tree)
+  => [DarcsFlag]
+  -> PatchSet p Origin wZ
+  -> FL (PatchInfoAnd p) wX wY
+  -> IO F.Format
+prepareBundle opts common to_be_sent =
+  signFormat (O.sign ? opts) $
+    makeBundle (unsafeCoerceP common) (mapFL_FL hopefully to_be_sent)
 
 sendBundle
   :: forall p wX wY
@@ -598,7 +591,7 @@ selectionIsNull :: Doc
 selectionIsNull = text "You don't want to send any patches, and that's fine with me!"
 
 emailBackedUp :: String -> Doc
-emailBackedUp mf = sentence $ "Email body left in" <+> text mf <> "."
+emailBackedUp mf = "Email body left in" <+> text mf <> "."
 
 promptCharSetWarning :: String -> String
 promptCharSetWarning msg = "Warning: " ++ msg ++ "  Send anyway?"
@@ -613,8 +606,8 @@ aborted :: Doc
 aborted = "Aborted."
 
 success :: String -> String -> Doc
-success to cc = sentence $
-    "Successfully sent patch bundle to:" <+> text to <+> copies cc
+success to cc =
+    "Successfully sent patch bundle to:" <+> text to <+> copies cc <> "."
   where
     copies "" = ""
     copies x  = "and cc'ed" <+> text x
@@ -623,7 +616,7 @@ postingPatch :: String -> Doc
 postingPatch url = "Posting patch to" <+> text url
 
 wroteBundle :: FilePathLike a => a -> Doc
-wroteBundle a = sentence $ "Wrote patch to" <+> text (toFilePath a)
+wroteBundle a = "Wrote patch to" <+> text (toFilePath a) <> "."
 
 savedButNotSent :: String -> Doc
 savedButNotSent to =
diff --git a/src/Darcs/UI/Commands/ShowDependencies.hs b/src/Darcs/UI/Commands/ShowDependencies.hs
index 00f9ea24..c008b3ca 100644
--- a/src/Darcs/UI/Commands/ShowDependencies.hs
+++ b/src/Darcs/UI/Commands/ShowDependencies.hs
@@ -25,7 +25,7 @@ import Darcs.Util.Printer
     , formatText
     , formatWords
     , hsep
-    , prefixLines
+    , prefix
     , putDocLn
     , quoted
     , renderString
@@ -152,7 +152,7 @@ depsGraph (ps :<: p) =
 renderDepsGraphAsDot :: M.Map PatchInfo (S.Set PatchInfo, S.Set PatchInfo) -> Doc
 renderDepsGraphAsDot g = vcat ["digraph {", indent body, "}"]
   where
-    indent = prefixLines ("  ")
+    indent = prefix "  "
     body = vcat
       [ "graph [rankdir=LR];"
       , "node [imagescale=true];"
diff --git a/src/Darcs/UI/Commands/ShowIndex.hs b/src/Darcs/UI/Commands/ShowIndex.hs
index b5d43f86..e67ef26f 100644
--- a/src/Darcs/UI/Commands/ShowIndex.hs
+++ b/src/Darcs/UI/Commands/ShowIndex.hs
@@ -39,7 +39,7 @@ import Darcs.Repository.Paths ( indexPath )
 
 import Darcs.Util.Hash ( showHash )
 import Darcs.Util.Tree( list, expand, itemHash, Tree, TreeItem( SubTree ) )
-import Darcs.Util.Index( IndexEntry(..), dumpIndex )
+import Darcs.Util.Tree.Index( IndexEntry(..), dumpIndex )
 import Darcs.Util.Path( anchorPath, AbsolutePath, anchoredRoot, realPath )
 import Darcs.Util.Printer ( Doc, putDocLn, text, vcat )
 
diff --git a/src/Darcs/UI/Commands/ShowRepo.hs b/src/Darcs/UI/Commands/ShowRepo.hs
index 99d266d7..201e6a52 100644
--- a/src/Darcs/UI/Commands/ShowRepo.hs
+++ b/src/Darcs/UI/Commands/ShowRepo.hs
@@ -32,11 +32,9 @@ import Darcs.UI.Completion ( noArgs )
 import Darcs.Repository
     ( Repository
     , RepoFormat
-    , PristineType
     , Cache
     , repoFormat
     , repoLocation
-    , repoPristineType
     , repoCache
     , withRepository
     , RepoJob(..)
@@ -110,7 +108,6 @@ repoCmd _ opts _ = do
 data RepoInfo = RepoInfo
   { riFormat :: RepoFormat
   , riRoot :: String
-  , riPristineType :: PristineType
   , riCache :: Cache
   , riPatchIndex :: String
   , riTestPref :: Maybe String
@@ -130,7 +127,6 @@ getRepoInfo
 getRepoInfo r opts = do
   let riFormat = repoFormat r
   let riRoot = repoLocation r
-  let riPristineType = repoPristineType r
   let riCache = repoCache r
   piExists <- doesPatchIndexExist riRoot
   piDisabled <- isPatchIndexDisabled riRoot
@@ -157,7 +153,6 @@ instance XML.Node RepoInfo where
     XML.node qn $
       [ XML.unode "format" $ showInOneLine riFormat
       , XML.unode "root" riRoot
-      , XML.unode "pristinetype" (show riPristineType)
       , XML.unode "cache" (showInOneLine riCache)
       , XML.unode "patchindex" riPatchIndex
       ]
@@ -179,7 +174,6 @@ showRepoInfo RepoInfo{..} =
   unlines $
     [ out "Format" $ showInOneLine riFormat
     , out "Root" riRoot
-    , out "PristineType" $ show riPristineType
     , out "Cache" $ showInOneLine $ riCache
     , out "PatchIndex" $ riPatchIndex
     ]
diff --git a/src/Darcs/UI/Commands/Test/Impl.hs b/src/Darcs/UI/Commands/Test/Impl.hs
index 256e171b..ca5a282b 100644
--- a/src/Darcs/UI/Commands/Test/Impl.hs
+++ b/src/Darcs/UI/Commands/Test/Impl.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
 module Darcs.UI.Commands.Test.Impl
     ( TestRunner(..), runStrategy
     , TestResult(..), TestResultValid(..), TestFailure(..)
diff --git a/src/Darcs/UI/Commands/TransferMode.hs b/src/Darcs/UI/Commands/TransferMode.hs
index e5e9d237..3c3b9e20 100644
--- a/src/Darcs/UI/Commands/TransferMode.hs
+++ b/src/Darcs/UI/Commands/TransferMode.hs
@@ -82,11 +82,11 @@ transfer = do 'g':'e':'t':' ':fn <- getLine
               x <- readfile fn
               case x of
                 Right c -> do putStrLn $ "got " ++ fn
-                              print $ B.length c
+                              putStrLn $ show $ B.length c
                               B.hPut stdout c
                               hFlush stdout
                 Left e -> do putStrLn $ "error " ++ fn
-                             print e
+                             putStrLn $ show e
                              hFlush stdout
               transfer
 
diff --git a/src/Darcs/UI/Commands/Unrecord.hs b/src/Darcs/UI/Commands/Unrecord.hs
index 0a456cfd..8bf561cc 100644
--- a/src/Darcs/UI/Commands/Unrecord.hs
+++ b/src/Darcs/UI/Commands/Unrecord.hs
@@ -92,9 +92,10 @@ import Darcs.UI.PrintPatch ( printFriendly )
 import Darcs.UI.SelectChanges ( WhichChanges(..), runSelection, selectionConfig )
 import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions(..) )
 import Darcs.Util.English ( presentParticiple )
-import Darcs.Util.Lock ( writeDocBinFile )
+import Darcs.Util.Format ( putFormat )
+import Darcs.Util.Lock ( writeFormatBinFile )
 import Darcs.Util.Path ( AbsolutePath, toFilePath, useAbsoluteOrStd )
-import Darcs.Util.Printer ( Doc, formatWords, putDoc, sentence, text, ($+$), (<+>) )
+import Darcs.Util.Printer ( Doc, formatWords, text, ($+$), (<+>) )
 import Darcs.Util.Progress ( debugMessage )
 import Darcs.Util.Prompt ( promptYorn )
 import Darcs.Util.SignalHandler ( catchInterrupt, withSignalsBlocked )
@@ -287,7 +288,7 @@ savetoBundle
 savetoBundle _ NilFL _ = return ()
 savetoBundle opts removed@(x :>: _) orig = do
   let kept = fromJust $ removeFromPatchSet removed orig
-      genFullBundle = makeBundle Nothing kept (mapFL_FL hopefully removed)
+      genFullBundle = return $ makeBundle kept (mapFL_FL hopefully removed)
   bundle <-
     if not (minimize ? opts)
       then genFullBundle
@@ -296,15 +297,15 @@ savetoBundle opts removed@(x :>: _) orig = do
           "Minimizing context, to generate bundle with full context hit ctrl-C..."
         (case minContext kept removed of
           Sealed (kept' :> removed') ->
-            makeBundle Nothing kept' (mapFL_FL hopefully removed'))
+            return $ makeBundle kept' (mapFL_FL hopefully removed'))
           `catchInterrupt` genFullBundle
   let filename = getUniqueDPatchName (patchDesc x)
   outname <- fromJust (getOutput opts filename)
   exists <- useAbsoluteOrStd (doesPathExist . toFilePath) (return False) outname
   when exists $
     fail $ "Directory or file named '" ++ (show outname) ++ "' already exists."
-  useAbsoluteOrStd writeDocBinFile putDoc outname bundle
-  putInfo opts $ sentence $
+  useAbsoluteOrStd writeFormatBinFile putFormat outname bundle
+  putInfo opts $ (<> ".") $
     useAbsoluteOrStd
       (("Saved patch bundle" <+>) . text . toFilePath)
       (text "stdout")
diff --git a/src/Darcs/UI/Commands/Util.hs b/src/Darcs/UI/Commands/Util.hs
index 454c1069..1f5bbc1f 100644
--- a/src/Darcs/UI/Commands/Util.hs
+++ b/src/Darcs/UI/Commands/Util.hs
@@ -251,7 +251,7 @@ remotePatches opts repository nirs = do
     patchSetUnion `fmap` mapM readNir nirsPaths
   where
     readNir n = do
-        r <- identifyRepositoryFor Reading repository (O.useCache ? opts) n
+        Sealed2 r <- identifyRepositoryFor Reading repository (O.useCache ? opts) n
         rps <- readPatches r
         return (Sealed rps)
 
diff --git a/src/Darcs/UI/Commands/WhatsNew.hs b/src/Darcs/UI/Commands/WhatsNew.hs
index 77e0da8a..ece18252 100644
--- a/src/Darcs/UI/Commands/WhatsNew.hs
+++ b/src/Darcs/UI/Commands/WhatsNew.hs
@@ -45,7 +45,7 @@ import Darcs.Patch.Show
     ( ShowContextPatch
     , ShowPatch(..)
     , ShowPatchBasic(..)
-    , displayPatch
+    , showPatch
     )
 import Darcs.Patch.TouchesFiles ( chooseTouching )
 import Darcs.Patch.Witnesses.Ordered
@@ -393,10 +393,10 @@ interactiveHunks = do
     adv_options = [ optionsView, optionsNav ]
 
 printPatchPager :: ShowPatchBasic p => p wX wY -> IO ()
-printPatchPager = viewDocWith fancyPrinters . displayPatch
+printPatchPager = viewDocWith fancyPrinters . showPatch
 
 printPatch :: ShowPatchBasic p => p wX wY -> IO ()
-printPatch = putDocLnWith fancyPrinters . displayPatch
+printPatch = putDocLnWith fancyPrinters . showPatch
 
 -- | An alias for 'whatsnew', with implicit @-l@ (and thus implicit @-s@)
 -- flags. We override the default description, to include these flags.
diff --git a/src/Darcs/UI/External.hs b/src/Darcs/UI/External.hs
index 77028404..ada48324 100644
--- a/src/Darcs/UI/External.hs
+++ b/src/Darcs/UI/External.hs
@@ -4,11 +4,11 @@ module Darcs.UI.External
     ( sendEmail
     , generateEmail
     , sendEmailDoc
-    , signString
+    , signFormat
     , verifyPS
-    , execDocPipe
-    , pipeDoc
-    , pipeDocSSH
+    , execFormatPipe
+    , pipeFormat
+    , pipeFormatSSH
     , viewDoc
     , viewDocWith
     , checkDefaultSendmail
@@ -54,7 +54,7 @@ import GHC.IO.Encoding
 #endif
 
 import Control.Concurrent ( forkIO, newEmptyMVar, putMVar, takeMVar )
-import Control.Exception ( IOException, finally, try )
+import Control.Exception ( IOException, catch, finally, throwIO, try )
 import System.IO.Error ( ioeGetErrorType )
 import GHC.IO.Exception ( IOErrorType(ResourceVanished) )
 #ifdef WIN32
@@ -73,7 +73,7 @@ import Darcs.Util.Path
     )
 import Darcs.Util.Progress ( withoutProgress, debugMessage )
 
-import Darcs.Util.ByteString (linesPS, unlinesPS)
+import Darcs.Util.ByteString ( gzWriteHandleBL, linesPS, unlinesPS )
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
 
@@ -86,6 +86,7 @@ import Darcs.Util.English ( orClauses )
 #endif
 import Darcs.Util.Exception ( catchall )
 import Darcs.Util.Exec ( execInteractive, exec, Redirect(..), withoutNonBlock )
+import Darcs.Util.Format ( Format, byteString, hPutFormat, toLazyByteString )
 import Darcs.Util.URL ( SshFilePath, sshUhost )
 import Darcs.Util.Printer
     ( Doc
@@ -95,8 +96,6 @@ import Darcs.Util.Printer
     , hPutDocLn
     , hPutDocLnWith
     , hPutDocWith
-    , packedString
-    , renderPS
     , renderString
     , simplePrinters
     , text
@@ -129,22 +128,35 @@ diffProgram = do
 darcsProgram :: IO String
 darcsProgram = getExecutablePath
 
-pipeDoc :: String -> [String] -> Doc -> IO ExitCode
-pipeDoc = pipeDocInternal (PipeToOther simplePrinters)
+pipeFormat :: String -> [String] -> Format -> IO ExitCode
+pipeFormat = pipeInternal (writeFormat (PipeToOther simplePrinters))
 
 data WhereToPipe = PipeToSsh Compression -- ^ if pipe to ssh, can choose to compress or not
                  | PipeToOther Printers  -- ^ otherwise, can specify printers
 
-pipeDocInternal :: WhereToPipe -> String -> [String] -> Doc -> IO ExitCode
-pipeDocInternal whereToPipe c args inp = withoutNonBlock $ withoutProgress $
+type Writer a = Handle -> a -> IO ()
+type Reader a = Handle -> IO a
+
+writeDoc :: WhereToPipe -> Writer Doc
+writeDoc wtp h inp =
+  case wtp of
+    PipeToSsh GzipCompression -> hPutDocCompr h inp
+    PipeToSsh NoCompression   -> hPutDoc h inp
+    PipeToOther printers      -> hPutDocWith printers h inp
+
+writeFormat :: WhereToPipe -> Writer Format
+writeFormat wtp h inp =
+  case wtp of
+    PipeToSsh GzipCompression -> gzWriteHandleBL h (toLazyByteString inp)
+    _                         -> hPutFormat h inp
+
+pipeInternal :: Writer a -> String -> [String] -> a -> IO ExitCode
+pipeInternal write c args inp = withoutNonBlock $ withoutProgress $
     do debugMessage $ "Exec: " ++ unwords (map show (c:args))
        (Just i,_,_,pid) <- createProcess (proc c args){ std_in = CreatePipe
                                                       , delegate_ctlc = True}
        debugMessage "Start transferring data"
-       case whereToPipe of
-          PipeToSsh GzipCompression -> hPutDocCompr i inp
-          PipeToSsh NoCompression   -> hPutDoc i inp
-          PipeToOther printers      -> hPutDocWith printers i inp
+       write i inp
        hClose i
        rval <- waitForProcess pid
        debugMessage "Finished transferring data"
@@ -152,10 +164,11 @@ pipeDocInternal whereToPipe c args inp = withoutNonBlock $ withoutProgress $
             putStrLn $ "Command not found:\n   "++ show (c:args)
        return rval
 
-pipeDocSSH :: Compression -> SshFilePath -> [String] -> Doc -> IO ExitCode
-pipeDocSSH compress remoteAddr args input = do
+pipeFormatSSH :: Compression -> SshFilePath -> [String] -> Format -> IO ExitCode
+pipeFormatSSH compress remoteAddr args input = do
     (ssh, ssh_args) <- getSSH SSH
-    pipeDocInternal (PipeToSsh compress) ssh (ssh_args ++ ("--":sshUhost remoteAddr:args)) input
+    pipeInternal (writeFormat (PipeToSsh compress))
+        ssh (ssh_args ++ ("--":sshUhost remoteAddr:args)) input
 
 sendEmail :: String -> String -> String -> String -> Maybe String -> String -> IO ()
 sendEmail f t s cc scmd body =
@@ -282,13 +295,19 @@ foreign import ccall "win32/send_email.h send_email" c_send_email
 #endif
 
 execPSPipe :: String -> [String] -> B.ByteString -> IO B.ByteString
-execPSPipe command args input =
+execPSPipe = execPipe B.hPut B.hGetContents
+
+execFormatPipe :: String -> [String] -> Format -> IO Format
+execFormatPipe = execPipe hPutFormat (fmap byteString . B.hGetContents)
+
+execPipe :: Writer a -> Reader b -> String -> [String] -> a -> IO b
+execPipe put get command args input =
   withoutProgress $ do
     (hi, ho, he, pid) <- runInteractiveProcess command args Nothing Nothing
-    _ <- forkIO $ B.hPut hi input >> hClose hi
+    _ <- forkIO $ put hi input >> hClose hi
     done <- newEmptyMVar
     _ <- forkIO $ (B.hGetContents he >>= B.hPut stderr) `finally` putMVar done ()
-    output <- B.hGetContents ho
+    output <- get ho
     rval <- waitForProcess pid
     takeMVar done
     case rval of
@@ -297,21 +316,20 @@ execPSPipe command args input =
         "External program '" ++ command ++ "' failed with exit code " ++ show ec
       ExitSuccess -> return output
 
-execDocPipe :: String -> [String] -> Doc -> IO Doc
-execDocPipe command args input =
-  packedString <$> execPSPipe command args (renderPS input)
+signFormat :: Sign -> Format -> IO Format
+signFormat NoSign d = return d
+signFormat Sign d = signFormatPGP [] d
+signFormat (SignAs keyid) d = signFormatPGP ["--local-user", keyid] d
+signFormat (SignSSL idf) d = signFormatSSL idf d
 
-signString :: Sign -> Doc -> IO Doc
-signString NoSign d = return d
-signString Sign d = signPGP [] d
-signString (SignAs keyid) d = signPGP ["--local-user", keyid] d
-signString (SignSSL idf) d = signSSL idf d
+signFormatPGP :: [String] -> Format -> IO Format
+signFormatPGP args = execFormatPipe "gpg" ("--clearsign":args)
 
-signPGP :: [String] -> Doc -> IO Doc
-signPGP args = execDocPipe "gpg" ("--clearsign":args)
+signFormatSSL :: String -> Format -> IO Format
+signFormatSSL = signSSL execFormatPipe
 
-signSSL :: String -> Doc -> IO Doc
-signSSL idfile t =
+signSSL :: (String -> [String] -> t -> IO t) -> String -> t -> IO t
+signSSL execWhatPipe idfile t =
     withTemp $ \cert -> do
     opensslPS ["req", "-new", "-key", idfile,
                "-outform", "PEM", "-days", "365"]
@@ -321,9 +339,9 @@ signSSL idfile t =
                                "-outform", "PEM", "-days", "365"]
                 >>= opensslPS ["x509", "-outform", "PEM"]
                 >>= B.writeFile cert
-    opensslDoc ["smime", "-sign", "-signer", cert,
+    openssl ["smime", "-sign", "-signer", cert,
                 "-inkey", idfile, "-noattr", "-text"] t
-    where opensslDoc = execDocPipe "openssl"
+    where openssl = execWhatPipe "openssl"
           opensslPS = execPSPipe "openssl"
 
 
@@ -405,9 +423,10 @@ viewDocWith pr msg = do
 #endif
                `ortryrunning` pipeDocToPager "" [] pr msg
      else pipeDocToPager "" [] pr msg
-              where lengthGreaterThan n _ | n <= 0 = True
-                    lengthGreaterThan _ [] = False
-                    lengthGreaterThan n (_:xs) = lengthGreaterThan (n-1) xs
+  `catch` \e -> if e==ExitSuccess then return () else throwIO e
+  where lengthGreaterThan n _ | n <= 0 = True
+        lengthGreaterThan _ [] = False
+        lengthGreaterThan n (_:xs) = lengthGreaterThan (n-1) xs
 
 getViewer :: IO (Maybe String)
 getViewer = Just `fmap` (getEnv "DARCS_PAGER" `catchall` getEnv "PAGER")
@@ -415,12 +434,14 @@ getViewer = Just `fmap` (getEnv "DARCS_PAGER" `catchall` getEnv "PAGER")
             return Nothing
 
 pipeDocToPager :: String -> [String] -> Printers -> Doc -> IO ExitCode
-
 pipeDocToPager "" _ pr inp = do
   hPutDocLnWith pr stdout inp
   return ExitSuccess
-
-pipeDocToPager c args pr inp = pipeDocInternal (PipeToOther pr) c args inp
+pipeDocToPager c args pr inp =
+  -- Evaluate pr with the current stdout, not the pipe's write end,
+  -- so we get colored output with less. Note that we pass it -R so
+  -- that it doesn't escape color codes.
+  pipeInternal (writeDoc (PipeToOther (const (pr stdout)))) c args inp
 
 -- | Given two shell commands as arguments, execute the former.  The
 -- latter is then executed if the former failed because the executable
diff --git a/src/Darcs/UI/PatchHeader.hs b/src/Darcs/UI/PatchHeader.hs
index f2bd62a8..ab8a2b4f 100644
--- a/src/Darcs/UI/PatchHeader.hs
+++ b/src/Darcs/UI/PatchHeader.hs
@@ -41,6 +41,7 @@ import Darcs.UI.External ( editFile )
 import Darcs.UI.Flags ( getEasyAuthor, promptAuthor, getDate )
 import Darcs.UI.Options ( Config, (?) )
 import qualified Darcs.UI.Options.All as O
+import Darcs.UI.Prompt ( promptYornorq )
 import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions(..) )
 import Darcs.UI.SelectChanges ( askAboutDepends )
 
@@ -48,8 +49,8 @@ import qualified Darcs.Util.Diff as D ( DiffAlgorithm )
 import Darcs.Util.English ( capitalize )
 import Darcs.Util.Global ( darcsLastMessage )
 import Darcs.Util.Path ( FilePathLike, toFilePath )
-import Darcs.Util.Prompt ( PromptConfig(..), askUser, promptChar, promptYorn )
-import Darcs.Util.Printer ( Doc, text, ($+$), vcat, prefixLines, renderString )
+import Darcs.Util.Prompt ( PromptConfig(..), askUser, promptChar )
+import Darcs.Util.Printer ( Doc, text, ($+$), vcat, prefix, renderString )
 import qualified Darcs.Util.Ratified as Ratified ( hGetContents )
 
 import Darcs.Util.Tree ( Tree )
@@ -184,11 +185,12 @@ getLog m_name has_pipe log_file ask_long m_old chs =
 
   is_badname = isJust . just_a_badname
 
-  prompt_long_comment oldname =
-    do let verb = case m_old of Nothing -> "add a"; Just _ -> "edit the"
-       y <- promptYorn $ "Do you want to "++verb++" long comment?"
-       if y then get_log_using_editor oldname
-            else return (oldname, default_log, Nothing)
+  prompt_long_comment oldname = do
+    let verb = case m_old of { Nothing -> "add a"; Just _ -> "edit the" }
+        edit = get_log_using_editor oldname
+        no_edit = return (oldname, default_log, Nothing)
+        prompt = "Do you want to " ++ verb ++ " long comment?"
+    promptYornorq prompt (verb ++ " long comment") edit no_edit
 
   get_log_using_editor p =
                        do let logf = darcsLastMessage
@@ -222,7 +224,7 @@ getLog m_name has_pipe log_file ask_long m_old chs =
         , text "#"
         , text "# Summary of selected changes:"
         , text "#"
-        , prefixLines (text "#") chs
+        , prefix "# " chs
         ]
 
 editLog :: Named prim wX wY -> IO (Named prim wX wY)
diff --git a/src/Darcs/UI/PrintPatch.hs b/src/Darcs/UI/PrintPatch.hs
index 3c8e15ba..0849d023 100644
--- a/src/Darcs/UI/PrintPatch.hs
+++ b/src/Darcs/UI/PrintPatch.hs
@@ -33,7 +33,6 @@ import Darcs.Patch.ApplyMonad ( ApplyMonadTrans )
 import Darcs.Patch.Show
     ( ShowContextPatch
     , ShowPatch
-    , ShowPatchFor(ForDisplay)
     , showPatchWithContext
     )
 import Darcs.UI.External ( viewDocWith )
@@ -77,4 +76,4 @@ contextualPrintPatchWithPager
   -> p wX wY
   -> IO ()
 contextualPrintPatchWithPager s p = do
-    showPatchWithContext ForDisplay s p >>= viewDocWith fancyPrinters
+    showPatchWithContext s p >>= viewDocWith fancyPrinters
diff --git a/src/Darcs/UI/Prompt.hs b/src/Darcs/UI/Prompt.hs
index b1370b05..ec7002f3 100644
--- a/src/Darcs/UI/Prompt.hs
+++ b/src/Darcs/UI/Prompt.hs
@@ -3,10 +3,12 @@ module Darcs.UI.Prompt
     ( PromptChoice(..)
     , PromptConfig(..)
     , runPrompt
+    , promptYornorq
     ) where
 
 import Darcs.Prelude
 import Data.List ( find, intercalate )
+import System.Exit ( exitSuccess )
 import qualified Darcs.Util.Prompt as P
 
 data PromptChoice a = PromptChoice
@@ -24,18 +26,23 @@ data PromptConfig a = PromptConfig
   }
 
 -- | Generate the help string from a verb and list of choice groups
-helpFor :: String -> [[PromptChoice a]] -> String
-helpFor jn choices =
+helpFor :: String -> [[PromptChoice a]] -> Maybe Char -> String
+helpFor jn choices def =
   unlines $
     [ "How to use " ++ jn ++ ":" ] ++
     intercalate [""] (map (map help . filter pcWhen) choices) ++
     [ ""
     , "?: show this help"
-    , ""
-    , "<Space>: accept the current default (which is capitalized)"
-    ]
+    ] ++ defaultHelp
   where
     help i = pcKey i : (": " ++ pcHelp i)
+    defaultHelp =
+      case def of
+        Nothing -> []
+        Just _ ->
+          [ ""
+          , "<Space>: accept the current default (which is capitalized)"
+          ]
 
 lookupAction :: Char -> [PromptChoice a] -> Maybe (IO a)
 lookupAction key choices = pcAction <$> find ((==key).pcKey) choices
@@ -48,4 +55,17 @@ runPrompt pcfg@PromptConfig{..} = do
       P.PromptConfig pPrompt (map pcKey choices) [] Nothing "?h"
   case lookupAction key choices of
     Just action -> action
-    Nothing -> putStrLn (helpFor pVerb pChoices) >> runPrompt pcfg
+    Nothing -> putStrLn (helpFor pVerb pChoices pDefault) >> runPrompt pcfg
+
+-- | Prompt the user for a yes or no or cancel
+promptYornorq :: String -> String -> IO a -> IO a -> IO a
+promptYornorq prompt verb yes no =
+    runPrompt (PromptConfig prompt verb choices Nothing)
+  where
+    quit = putStrLn "Command cancelled." >> exitSuccess
+    choices =
+      [ [ PromptChoice 'y' True yes ("yes, do " ++ verb)
+        , PromptChoice 'n' True no ("no, don't " ++ verb)
+        , PromptChoice 'q' True quit "quit (cancel command)"
+        ]
+      ]
diff --git a/src/Darcs/UI/RunCommand.hs b/src/Darcs/UI/RunCommand.hs
index ad799310..f682fd20 100644
--- a/src/Darcs/UI/RunCommand.hs
+++ b/src/Darcs/UI/RunCommand.hs
@@ -40,7 +40,7 @@ import Darcs.UI.Options.All
 
 import Darcs.UI.Defaults ( applyDefaults )
 import Darcs.UI.External ( viewDoc )
-import Darcs.UI.Flags ( DarcsFlag, matchAny, withNewRepo )
+import Darcs.UI.Flags ( DarcsFlag, matchAny )
 import Darcs.UI.Commands
     ( CommandArgs( CommandOnly, SuperCommandOnly, SuperCommandSub )
     , CommandControl
@@ -60,7 +60,6 @@ import Darcs.UI.Commands
     , superName
     )
 import Darcs.UI.Commands.GZCRCs ( doCRCWarnings )
-import Darcs.UI.Commands.Clone ( makeRepoName, cloneToSSH )
 import Darcs.UI.RunHook ( runPosthook, runPrehook )
 import Darcs.UI.Usage
     ( getCommandHelp
@@ -73,7 +72,7 @@ import Darcs.Repository.Prefs ( Pref(Defaults), getGlobal, getPreflist )
 import Darcs.Util.AtExit ( atexit )
 import Darcs.Util.Exception ( die )
 import Darcs.Util.Global ( setDebugMode, setTimingsMode )
-import Darcs.Util.Path ( AbsolutePath, getCurrentDirectory, toPath, ioAbsoluteOrRemote, makeAbsolute )
+import Darcs.Util.Path ( AbsolutePath, getCurrentDirectory )
 import Darcs.Util.Printer ( (<+>), ($+$), renderString, text, vcat )
 import Darcs.Util.Printer.Color ( ePutDocLn )
 import Darcs.Util.Progress ( setProgressMode )
@@ -150,9 +149,9 @@ runWithHooks cmd (new_wd, old_wd) flags extra = do
    preHookExitCode <- runPrehook (pre hooksCfg) verb new_wd
    if preHookExitCode /= ExitSuccess
       then exitWith preHookExitCode
-      else do phDir <- getPosthookDir new_wd cmd flags extra
-              commandCommand cmd (new_wd, old_wd) flags extra
-              postHookExitCode <- runPosthook (post hooksCfg) verb phDir
+      else do commandCommand cmd (new_wd, old_wd) flags extra
+              wd <- getCurrentDirectory
+              postHookExitCode <- runPosthook (post hooksCfg) verb wd
               exitWith postHookExitCode
 
 setGlobalVariables :: Verbosity -> Bool -> Bool -> IO ()
@@ -162,24 +161,6 @@ setGlobalVariables verb debug timings = do
   when (verb == Quiet) $ setProgressMode False
   unless (verb == Quiet) $ atexit $ doCRCWarnings (verb == Verbose)
 
--- | Returns the working directory for the posthook. For most commands, the
--- first parameter is returned. For the \'get\' command, the path of the newly
--- created repository is returned if it is not an ssh url.
-getPosthookDir :: AbsolutePath -> DarcsCommand -> [DarcsFlag] -> [String] -> IO AbsolutePath
-getPosthookDir new_wd cmd flags extra | commandName cmd `elem` ["get","clone"] = do
-    case extra of
-      [inrepodir, outname] -> getPosthookDir new_wd cmd (withNewRepo outname flags) [inrepodir]
-      [inrepodir] ->
-        case cloneToSSH flags of
-         Nothing -> do
-          repodir <- toPath <$> ioAbsoluteOrRemote inrepodir
-          newRepo <- makeRepoName False flags repodir
-          return $ makeAbsolute new_wd newRepo
-         _ -> return new_wd
-      _ -> die "You must provide 'clone' with either one or two arguments."
-getPosthookDir new_wd _ _ _ = return new_wd
-
-
 -- | Checks if the number of extra arguments matches the number of extra
 -- arguments supported by the command as specified in `commandExtraArgs`.
 -- Extra arguments are arguments that follow the command but aren't
diff --git a/src/Darcs/UI/SelectChanges.hs b/src/Darcs/UI/SelectChanges.hs
index e2c73b53..f5b71157 100644
--- a/src/Darcs/UI/SelectChanges.hs
+++ b/src/Darcs/UI/SelectChanges.hs
@@ -288,12 +288,11 @@ iswanted extract mflags = MatchCriterion
 
 -- | Run a 'PatchSelection' action in the given 'SelectionConfig',
 -- without assuming that patches are invertible.
-runSelection :: ( MatchableRP p, ShowPatch p, ShowContextPatch p
-                , ApplyState p ~ Tree, ApplyState p ~ ApplyState (PrimOf p)
-                )
-             => FL p wX wY
-             -> SelectionConfig p
-             -> IO ((FL p :> FL p) wX wY)
+runSelection
+  :: (MatchableRP p, ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree)
+  => FL p wX wY
+  -> SelectionConfig p
+  -> IO ((FL p :> FL p) wX wY)
 runSelection _ PSC { splitter = Just _ } =
   -- a Splitter makes sense for prim patches only and these are invertible anyway
   error "cannot use runSelection with Splitter"
@@ -393,7 +392,7 @@ runInvertibleSelection ps psc = runReaderT (selection ps) psc where
   {- end of runInvertibleSelection -}
 
 -- | The equivalent of 'runSelection' for the @darcs log@ command
-viewChanges :: (ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree)
+viewChanges :: (ShowPatch p, ShowContextPatch p)
             => PatchSelectionOptions -> [Sealed2 p] -> IO ()
 viewChanges ps_opts = textView ps_opts Nothing 0 []
 
@@ -422,7 +421,7 @@ keysFor = concatMap (map kp)
 
 -- | The function for selecting a patch to amend record. Read at your own risks.
 withSelectedPatchFromList
-    :: (Commute p, Matchable p, ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree)
+    :: (Commute p, Matchable p, ShowPatch p, ShowContextPatch p)
     => String   -- name of calling command (always "amend" as of now)
     -> RL p wX wY
     -> PatchSelectionOptions
@@ -446,7 +445,7 @@ data WithSkipped p wX wY = WithSkipped
 -- patches, including pending and also that the skipped sequences has an
 -- ending context that matches the recorded state, z, of the repository.
 wspfr :: forall p wX wY wZ.
-         (Commute p, Matchable p, ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree)
+         (Commute p, Matchable p, ShowPatch p, ShowContextPatch p)
       => String
       -> (forall wA wB . p wA wB -> Bool)
       -> RL p wX wY
@@ -537,7 +536,7 @@ initialSelectionState lps pcs =
 
 -- | The actual interactive selection process.
 textSelect :: ( Commute p, Invert p, ShowPatch p, ShowContextPatch p
-              , PatchInspect p, ApplyState p ~ Tree )
+              , PatchInspect p )
            => FL (LabelledPatch p) wX wY
            -> PatchChoices p wX wY
            -> PatchSelectionM p IO (PatchChoices p wX wY)
@@ -551,7 +550,7 @@ textSelect lps' pcs =
       unless (rightmost z) $ textSelect'
 
 textSelect' :: ( Commute p, Invert p, ShowPatch p, ShowContextPatch p
-               , PatchInspect p, ApplyState p ~ Tree )
+               , PatchInspect p )
             => InteractiveSelectionM p wX wY ()
 textSelect' = do
   z <- gets lps
@@ -904,7 +903,7 @@ printCurrent = do
       liftIO $ printFriendly (verbosity o) (withSummary o) $ unLabel lp
 
 -- | The interactive part of @darcs changes@
-textView :: (ShowPatch p, ShowContextPatch p, ApplyState p ~ Tree)
+textView :: (ShowPatch p, ShowContextPatch p)
          => PatchSelectionOptions -> Maybe Int -> Int
          -> [Sealed2 p] -> [Sealed2 p]
          -> IO ()
diff --git a/src/Darcs/UI/TheCommands.hs b/src/Darcs/UI/TheCommands.hs
index 81776014..c1effec6 100644
--- a/src/Darcs/UI/TheCommands.hs
+++ b/src/Darcs/UI/TheCommands.hs
@@ -60,7 +60,8 @@ commandControlList =
     [ commandGroup "Most used/starting out:"
     , normalCommand initialize
     , normalCommand add
-    , normalCommand whatsnew, hiddenCommand status
+    , normalCommand whatsnew
+    , normalCommand status
     , normalCommand record, hiddenCommand commit
     , normalCommand clone, hiddenCommand get, hiddenCommand put
     , normalCommand pull
diff --git a/src/Darcs/Util/ByteString.hs b/src/Darcs/Util/ByteString.hs
index ee5013b8..cc99eefb 100644
--- a/src/Darcs/Util/ByteString.hs
+++ b/src/Darcs/Util/ByteString.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Darcs.Util.ByteString
@@ -19,10 +18,12 @@ module Darcs.Util.ByteString
     -- * IO with mmap or gzip
       gzReadFilePS
     , mmapFilePS
+    , gzWriteFile
     , gzWriteFilePS
     , gzWriteFilePSs
     , gzReadStdin
     , gzWriteHandle
+    , gzWriteHandleBL
     , FileSegment
     , readSegment
     -- * gzip handling
@@ -32,6 +33,8 @@ module Darcs.Util.ByteString
     , dropSpace
     , linesPS
     , unlinesPS
+    , linesBS
+    , unlinesBS
     , hashPS
     , breakFirstPS
     , breakLastPS
@@ -62,6 +65,7 @@ import qualified Data.ByteString.Char8      as BC
 import qualified Data.ByteString.Lazy       as BL
 import Data.ByteString (intercalate)
 import qualified Data.ByteString.Base16     as B16
+import qualified Data.ByteString.Short      as BS
 
 import System.Directory ( getFileSize )
 import System.IO ( withFile, IOMode(ReadMode)
@@ -84,10 +88,7 @@ import qualified Codec.Compression.Zlib.Internal as ZI
 import Darcs.Util.Encoding ( decode, encode, decodeUtf8, encodeUtf8 )
 import Darcs.Util.Global ( addCRCWarning )
 
-#if mingw32_HOST_OS
-#else
 import System.IO.MMap( mmapFileByteString )
-#endif
 import System.Mem( performGC )
 
 ------------------------------------------------------------------------
@@ -166,6 +167,19 @@ linesPS ps
 unlinesPS :: [B.ByteString] -> B.ByteString
 unlinesPS = B.concat . intersperse (BC.singleton '\n')
 
+{-# INLINE linesBS #-}
+-- | Split the input into lines, that is, sections separated by '\n' bytes,
+-- unless it is empty, in which case the result has one empty line.
+linesBS :: BS.ShortByteString -> [BS.ShortByteString]
+linesBS ps
+     | BS.null ps = [BS.empty]
+     | otherwise = BS.split 10 ps
+
+{-# INLINE unlinesBS #-}
+-- | Concatenate the inputs with '\n' bytes in interspersed.
+unlinesBS :: [BS.ShortByteString] -> BS.ShortByteString
+unlinesBS = BS.concat . intersperse (BS.singleton 10)
+
 -- properties of linesPS and unlinesPS
 
 prop_unlinesPS_linesPS_left_inverse :: B.ByteString -> Bool
@@ -247,6 +261,9 @@ hGetLittleEndInt h = do
     b4 <- ord `fmap` hGetChar h
     return $ b1 + 256*b2 + 65536*b3 + 16777216*b4
 
+gzWriteFile :: FilePath -> BL.ByteString -> IO ()
+gzWriteFile f = BL.writeFile f . GZ.compress
+
 gzWriteFilePS :: FilePath -> B.ByteString -> IO ()
 gzWriteFilePS f ps = gzWriteFilePSs f [ps]
 
@@ -258,6 +275,9 @@ gzWriteHandle :: Handle -> [B.ByteString] -> IO ()
 gzWriteHandle h pss  =
     BL.hPut h $ GZ.compress $ BL.fromChunks pss
 
+gzWriteHandleBL :: Handle -> BL.ByteString -> IO ()
+gzWriteHandleBL h = BL.hPut h . GZ.compress
+
 -- | Read standard input, which may or may not be gzip compressed, directly
 -- into a 'B.ByteString'.
 gzReadStdin :: IO B.ByteString
@@ -310,9 +330,6 @@ readSegment (f,range) = do
 -- is modified.
 
 mmapFilePS :: FilePath -> IO B.ByteString
-#if mingw32_HOST_OS
-mmapFilePS = B.readFile
-#else
 mmapFilePS f =
   mmapFileByteString f Nothing
    `catchIOError` (\_ -> do
@@ -320,7 +337,6 @@ mmapFilePS f =
                      if size == 0
                         then return B.empty
                         else performGC >> mmapFileByteString f Nothing)
-#endif
 
 -- -------------------------------------------------------------------------
 -- fromPS2Hex
diff --git a/src/Darcs/Util/Cache.hs b/src/Darcs/Util/Cache.hs
index 7933c5ca..bed63168 100644
--- a/src/Darcs/Util/Cache.hs
+++ b/src/Darcs/Util/Cache.hs
@@ -14,6 +14,7 @@ module Darcs.Util.Cache
     , cleanCaches
     , cleanCachesWithHint
     , fetchFileUsingCache
+    , relinkUsingCache
     , speculateFileUsingCache
     , speculateFilesUsingCache
     , writeFileUsingCache
@@ -25,13 +26,15 @@ module Darcs.Util.Cache
     , hashedFilePath
     , allHashedDirs
     , reportBadSources
+    , setThisRepo
     , closestWritableDirectory
     , dropNonRepos
     ) where
 
 import Control.Concurrent.MVar ( MVar, modifyMVar_, newMVar, readMVar )
-import Control.Monad ( filterM, forM_, liftM, mplus, unless, when )
+import Control.Monad ( filterM, forM_, liftM, unless, when, void )
 import qualified Data.ByteString as B ( ByteString )
+import qualified Data.ByteString.Lazy as BL ( ByteString )
 import Data.List ( intercalate, nub, sortBy )
 import Data.Maybe ( catMaybes, fromMaybe, listToMaybe )
 import System.Directory
@@ -65,7 +68,7 @@ import Darcs.Util.File
     , withTemp
     )
 import Darcs.Util.Global ( darcsdir, defaultRemoteDarcsCmd )
-import Darcs.Util.Lock ( gzWriteAtomicFilePS )
+import Darcs.Util.Lock ( gzWriteAtomicFile )
 import Darcs.Util.Progress ( debugMessage, progressList )
 import Darcs.Util.URL ( isHttpUrl, isSshUrl, isValidLocalPath )
 import Darcs.Util.ValidHash
@@ -210,6 +213,11 @@ closestWritableDirectory (Ca cs) =
     Cache Directory Writable x -> Just x
     _ -> Nothing
 
+setThisRepo :: String -> WritableOrNot -> Cache -> Cache
+setThisRepo location wr (Ca cs) = Ca (map f cs) where
+  f (Cache Repo _ l) | l == location = Cache Repo wr l
+  f x = x
+
 isThisRepo :: CacheLoc -> Bool
 isThisRepo (Cache Repo Writable _) = True
 isThisRepo _ = False
@@ -244,12 +252,33 @@ peekInCache (Ca cache) sh = cacheHasIt cache `catchall` return False
             ex <- doesFileExist $ hashedFilePath c subdir (encodeValidHash sh)
             if ex then return True else cacheHasIt cs
 
+finalErrorMessage :: Cache -> HashedDir -> FilePath -> String
+finalErrorMessage cache subdir filename =
+  "Couldn't fetch " ++ filename ++
+  "\nin subdir " ++ hashedDir subdir ++
+  " from sources:\n" ++ show cache ++
+  if subdir == HashedPristineDir
+    then "\nRun `darcs repair` to fix this problem."
+    else ""
+
+-- | Ensure that all writable locations have a (hard link) copy of the
+-- file with the given hash. If necessary, download the file.
+relinkUsingCache :: ValidHash h => Cache -> h -> IO ()
+relinkUsingCache cache hash = do
+    copyFileUsingCache ActuallyCopy cache subdir filename >>= \case
+      Just path -> mapM_ (relink path) (cacheEntries cache)
+      Nothing -> fail $ finalErrorMessage cache subdir filename
+  where
+    filename = encodeValidHash hash
+    subdir = dirofValidHash hash
+    relink path = tryLinking path filename subdir
+
 -- | Add pipelined downloads to the (low-priority) queue, for the rest it is a noop.
 speculateFileUsingCache :: ValidHash h => Cache -> h -> IO ()
 speculateFileUsingCache c hash = do
     let filename = encodeValidHash hash
     debugMessage $ "Speculating on " ++ filename
-    copyFileUsingCache OnlySpeculate c (dirofValidHash hash) filename
+    void $ copyFileUsingCache OnlySpeculate c (dirofValidHash hash) filename
 
 -- | Do 'speculateFilesUsingCache' for files not already in a writable cache
 -- position.
@@ -263,6 +292,18 @@ data OrOnlySpeculate = ActuallyCopy
                      | OnlySpeculate
                      deriving ( Eq, Show )
 
+data CopyResult
+  = NoWritableLocation
+  | AlreadyExists FilePath
+  | StickItHere FilePath
+
+instance Semigroup CopyResult where
+  AlreadyExists f <> _ = AlreadyExists f
+  _ <> AlreadyExists f = AlreadyExists f
+  StickItHere f <> _ = StickItHere f
+  _ <> StickItHere f = StickItHere f
+  _ <> _ = NoWritableLocation
+
 -- | If the first parameter of type 'OrOnlySpeculate' is 'ActuallyCopy', try to
 -- ensure that a file with the given name (hash) exists in a writable location
 -- (which means in particular that it is stored in the local file system). If
@@ -280,29 +321,35 @@ data OrOnlySpeculate = ActuallyCopy
 -- 'speculateFileOrUrl' and try only the first non-writable location (which
 -- makes sense since 'speculateFileOrUrl' is asynchronous and thus can't fail
 -- in any interesting way).
-copyFileUsingCache :: OrOnlySpeculate -> Cache -> HashedDir -> FilePath -> IO ()
+copyFileUsingCache
+  :: OrOnlySpeculate -> Cache -> HashedDir -> FilePath -> IO (Maybe FilePath)
 copyFileUsingCache oos (Ca cache) subdir f = do
     debugMessage $ unwords ["copyFileUsingCache:", show oos, hashedDir subdir, f]
-    Just stickItHere <- cacheLoc cache
-    createDirectoryIfMissing True (dropFileName stickItHere)
-    filterBadSources cache >>= sfuc stickItHere
-    `catchall`
-    return ()
+    cacheLoc cache >>= \case
+      NoWritableLocation -> return Nothing
+      AlreadyExists r -> return $ Just r
+      StickItHere r -> do
+        createDirectoryIfMissing True (dropFileName r)
+        filterBadSources cache >>= sfuc r
+        return (Just r)
+        `catchall`
+        return Nothing
   where
     -- Return last writeable cache/repo location for file 'f'.
     -- Usually returns the global cache unless `--no-cache` is passed.
     -- Throws exception if file already exists in a writable location.
-    cacheLoc [] = return Nothing
+    cacheLoc [] = return NoWritableLocation
     cacheLoc (c : cs)
         | not $ writable c = cacheLoc cs
         | otherwise = do
             let attemptPath = hashedFilePath c subdir f
             ex <- doesFileExist attemptPath
             if ex
-                then fail "File already present in writable location."
+                then
+                    return $ AlreadyExists attemptPath
                 else do
                     othercache <- cacheLoc cs
-                    return $ othercache `mplus` Just attemptPath
+                    return $ othercache <> StickItHere attemptPath
     -- Do the actual copy, or hard link, or put file in download queue. This
     -- tries to find the file in all non-writable locations, in order, unless
     -- we have OnlySpeculate.
@@ -385,7 +432,7 @@ fetchFileUsingCachePrivate :: ValidHash h => FromWhere -> Cache -> h
                            -> IO (FilePath, B.ByteString)
 fetchFileUsingCachePrivate fromWhere (Ca cache) hash = do
     when (fromWhere == Anywhere) $
-        copyFileUsingCache ActuallyCopy (Ca cache) subdir filename
+        void $ copyFileUsingCache ActuallyCopy (Ca cache) subdir filename
     filterBadSources cache >>= ffuc
   where
     filename = encodeValidHash hash
@@ -399,15 +446,9 @@ fetchFileUsingCachePrivate fromWhere (Ca cache) hash = do
             debugMessage $
               "In fetchFileUsingCachePrivate I'm directly grabbing file contents from "
               ++ cacheFile
-            x <- gzFetchFilePS cacheFile Cachable
-            if not $ checkHash hash x
-                then do
-                    x' <- fetchFilePS cacheFile Cachable
-                    unless (checkHash hash x') $ do
-                        hPutStrLn stderr $ "Hash failure in " ++ cacheFile
-                        fail $ "Hash failure in " ++ cacheFile
-                    return (cacheFile, x')
-                else return (cacheFile, x) -- FIXME: create links in caches
+            x <- fetchFileContent cacheFile False
+            -- FIXME: create links in caches
+            return (cacheFile, x)
             `catchall` do
                 -- something bad happened, check if cache became unaccessible
                 -- and try other ones
@@ -415,17 +456,7 @@ fetchFileUsingCachePrivate fromWhere (Ca cache) hash = do
                 filterBadSources cs >>= ffuc
         | writable c = do
             debugMessage $ "About to gzFetchFilePS from " ++ show cacheFile
-            x1 <- gzFetchFilePS cacheFile Cachable
-            debugMessage "gzFetchFilePS done."
-            x <- if not $ checkHash hash x1
-                     then do
-                        x2 <- fetchFilePS cacheFile Cachable
-                        unless (checkHash hash x2) $ do
-                            hPutStrLn stderr $ "Hash failure in " ++ cacheFile
-                            removeFile cacheFile
-                            fail $ "Hash failure in " ++ cacheFile
-                        return x2
-                     else return x1
+            x <- fetchFileContent cacheFile True
             -- Linking is optional here; the catchall prevents darcs from
             -- failing if repo and cache are on different file systems.
             mapM_ (tryLinking cacheFile filename subdir) cs `catchall` return ()
@@ -453,13 +484,24 @@ fetchFileUsingCachePrivate fromWhere (Ca cache) hash = do
         | otherwise = ffuc cs
         where
           cacheFile = hashedFilePath c subdir filename
-
-    ffuc [] = fail ("Couldn't fetch " ++ filename ++ "\nin subdir "
-                          ++ hashedDir subdir ++ " from sources:\n"
-                          ++ show (Ca cache)
-                          ++ if subdir == HashedPristineDir
-                             then "\nRun `darcs repair` to fix this problem."
-                             else "")
+          fetchFileContent path wr = do
+            content <- gzFetchFilePS path Cachable
+            if checkHash hash content
+              then return content
+              else do
+                -- This is quite defensive. If the file has the initial two
+                -- ID bytes that identify it as gzipped and even correctly
+                -- unzips, how great are the chances that interpreting it as
+                -- a plain unzipped file succeeds? I am missing a justification
+                -- for this complication here...
+                content' <- fetchFilePS path Cachable
+                unless (checkHash hash content') $ do
+                  hPutStrLn stderr $ "Hash failure in " ++ path
+                  when wr $ removeFile path
+                  fail $ "Hash failure in " ++ path
+                return content'
+
+    ffuc [] = fail $ finalErrorMessage (Ca cache) subdir filename
 
 tryLinking :: FilePath -> FilePath -> HashedDir -> CacheLoc -> IO ()
 tryLinking source filename subdir c =
@@ -478,7 +520,7 @@ createCache _ _ _ = return ()
 -- which case merely create a hard link to that file. The returned value
 -- is the size and hash of the content.
 writeFileUsingCache
-  :: ValidHash h => Cache -> B.ByteString -> IO h
+  :: ValidHash h => Cache -> BL.ByteString -> IO h
 writeFileUsingCache (Ca cache) content = do
     debugMessage $ "writeFileUsingCache "++filename
     (fn, _) <- fetchFileUsingCachePrivate LocalOnly (Ca cache) hash
@@ -498,7 +540,7 @@ writeFileUsingCache (Ca cache) content = do
         | otherwise = do
             createCache c subdir filename
             let cacheFile = hashedFilePath c subdir filename
-            gzWriteAtomicFilePS cacheFile content
+            gzWriteAtomicFile cacheFile content
             -- create links in all other writable locations
             debugMessage $ "writeFileUsingCache remaining sources:\n"++show (Ca cs)
             -- Linking is optional here; the catchall prevents darcs from
diff --git a/src/Darcs/Util/Format.hs b/src/Darcs/Util/Format.hs
new file mode 100644
index 00000000..e9220ac4
--- /dev/null
+++ b/src/Darcs/Util/Format.hs
@@ -0,0 +1,142 @@
+module Darcs.Util.Format
+  ( Format
+  -- * Primitive constructors
+  , ascii
+  , stringUtf8
+  , byteString
+  , shortByteString
+  , byteStringHex
+  , userchunk
+  , intDec
+  , word64Dec
+  , listWord8Hex
+  , newline
+  -- * Combinators
+  , ($$)
+  , (<+>)
+  , hsep
+  , vcat
+  , vsep
+  , protect
+  -- * Output
+  , toLazyByteString
+  , toStrictByteString -- temporary, should eventually go away
+  , toDoc -- for email rendering
+  , hPutFormat
+  , putFormat
+  ) where
+
+import Darcs.Prelude
+
+import qualified Data.ByteString as B ( ByteString, null )
+import qualified Data.ByteString.Builder as B
+import Data.ByteString.Builder.Prim ( primMapListFixed, word8HexFixed )
+import qualified Data.ByteString.Lazy as BL ( ByteString, toStrict )
+import qualified Data.ByteString.Short as BS ( ShortByteString, null )
+import Data.Word ( Word8, Word64 )
+import System.IO ( Handle, stdout )
+
+import Darcs.Util.ByteString ( encodeLocale )
+import Darcs.Util.Printer ( Doc, packedString )
+
+-- | Simple wrapper type for 'B.Builder'. It is needed only because there is no
+-- way to inspect a 'B.Builder' to check if it is empty; which is needed for
+-- '$$' and '<+>' to have a unit.
+data Format = Empty | Nonempty B.Builder
+
+instance Semigroup Format where
+  Empty <> x = x
+  x <> Empty = x
+  Nonempty x <> Nonempty y = Nonempty (x <> y)
+
+instance Monoid Format where
+  mempty = Empty
+
+infixr 6 <+>
+(<+>) :: Format -> Format -> Format
+Empty <+> y = y
+x <+> Empty = x
+Nonempty x <+> Nonempty y = Nonempty (x <> B.char7 ' ' <> y)
+
+infixr 5 $$
+($$) :: Format -> Format -> Format
+Empty $$ y = y
+x $$ Empty = x
+x $$ y = x <> newline <> y
+
+infixr 5 $+$
+($+$) :: Format -> Format -> Format
+Empty $+$ y = y
+x $+$ Empty = x
+x $+$ y = x <> newline <> newline <> y
+
+newline :: Format
+newline = ascii "\n"
+
+vcat :: [Format] -> Format
+vcat = foldr ($$) mempty
+
+hsep :: [Format] -> Format
+hsep = foldr (<+>) mempty
+
+vsep :: [Format] -> Format
+vsep = foldr ($+$) mempty
+
+-- | Declare a 'Format' nonempty, regardless of its content. This 'protect's it
+-- from being eliminated by combinators (like '$$' or 'mconcat'), thus the name.
+protect :: Format -> Format
+protect Empty = Nonempty mempty
+protect f = f
+
+nonempty :: (t -> Bool) -> (t -> B.Builder) -> t -> Format
+nonempty test build arg
+  | test arg = Empty
+  | otherwise = Nonempty (build arg)
+
+ascii :: String -> Format
+ascii = nonempty null B.string7
+
+stringUtf8 :: String -> Format
+stringUtf8 = nonempty null B.stringUtf8
+
+byteString :: B.ByteString -> Format
+byteString = nonempty B.null B.byteString
+
+shortByteString :: BS.ShortByteString -> Format
+shortByteString = nonempty BS.null B.shortByteString
+
+byteStringHex :: B.ByteString -> Format
+byteStringHex = nonempty B.null B.byteStringHex
+
+intDec :: Int -> Format
+intDec = Nonempty . B.intDec
+
+word64Dec :: Word64 -> Format
+word64Dec = Nonempty . B.word64Dec
+
+listWord8Hex :: [Word8] -> Format
+listWord8Hex = nonempty null (primMapListFixed word8HexFixed)
+
+-- | User-provided (potentially) non-ascii 'String's are rendered
+-- using 'encodeLocale'. Should ideally go away eventually.
+userchunk :: String -> Format
+userchunk = byteString . encodeLocale
+
+unFormat :: Format -> B.Builder
+unFormat Empty = mempty
+unFormat (Nonempty x) = x
+
+toLazyByteString :: Format -> BL.ByteString
+toLazyByteString = B.toLazyByteString . unFormat
+
+toStrictByteString :: Format -> B.ByteString
+toStrictByteString = BL.toStrict . toLazyByteString
+
+toDoc :: Format -> Doc
+toDoc = packedString . toStrictByteString
+
+hPutFormat :: Handle -> Format -> IO ()
+hPutFormat h = B.hPutBuilder h . unFormat
+
+putFormat :: Format -> IO ()
+putFormat = hPutFormat stdout
diff --git a/src/Darcs/Util/HTTP.hs b/src/Darcs/Util/HTTP.hs
index d9fca864..abda0a4d 100644
--- a/src/Darcs/Util/HTTP.hs
+++ b/src/Darcs/Util/HTTP.hs
@@ -8,13 +8,22 @@ module Darcs.Util.HTTP
     , configureHttpConnectionManager
     ) where
 
-import Control.Concurrent.Async ( async, cancel, poll )
+import Control.Concurrent.Async ( async, cancel )
+import Control.Concurrent.Chan ( Chan, newChan, readChan, writeChan )
+import Control.Concurrent.STM
+    ( STM
+    , TVar
+    , atomically
+    , newTVarIO
+    , readTVar
+    , writeTVar
+    )
 import Control.Exception ( catch )
-import Control.Monad ( void , (>=>) )
+import Control.Monad ( void, when, (>=>) )
 import Crypto.Random ( seedNew, seedToInteger )
 import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as BL
 
 import Data.Conduit.Combinators ( sinkLazy )
 
@@ -59,6 +68,7 @@ import qualified Network.TLS as TLS
 import Numeric ( showHex )
 import System.Directory ( renameFile )
 import System.Environment ( lookupEnv )
+import System.IO.Unsafe ( unsafePerformIO )
 import Text.Read ( readMaybe )
 
 import Darcs.Prelude
@@ -100,21 +110,42 @@ copyRemoteLazy url cachable = do
 
 speculateRemote :: String -> FilePath -> IO ()
 speculateRemote url path = do
-  r <- async $ do
-    debugMessage $ "Start speculating on " ++ url
-    -- speculations are always Cachable
-    copyRemote url path Cachable
-    debugMessage $ "Completed speculating on " ++ url
-  atexit $ do
-    result <- poll r
-    case result of
-      Just (Right ()) ->
-        debugMessage $ "Already completed speculating on " ++ url
-      Just (Left e) ->
-        debugMessage $ "Speculating on " ++ url ++ " failed: " ++ show e
-      Nothing -> do
-        debugMessage $ "Abort speculating on " ++ url
-        cancel r
+  writeChan speculateQ (url,path)
+  (_, qsize) <- atomically $ modifyTVar speculateQSize (+1)
+  numThreads <- atomically $ readTVar speculateNumThreads
+  when (numThreads < speculateNumThreadsMax && qsize > 10) $ do
+    _ <- atomically $ modifyTVar speculateNumThreads (+1)
+    tid <- async speculateThread
+    atexit $ cancel tid
+
+speculateThread :: IO ()
+speculateThread = do
+  _ <- atomically $ modifyTVar speculateQSize (subtract 1)
+  (url, path) <- readChan speculateQ
+  debugMessage $ "Start speculating on " ++ url
+  -- speculations are always Cachable
+  copyRemote url path Cachable
+  debugMessage $ "Completed speculating on " ++ url
+  speculateThread
+
+modifyTVar :: TVar a -> (a -> a) -> STM (a, a)
+modifyTVar v f = do
+  x <- readTVar v
+  let x' = f x
+  writeTVar v x'
+  return (x, x')
+
+speculateNumThreadsMax :: Int
+speculateNumThreadsMax = 200
+
+speculateNumThreads :: TVar Int
+speculateNumThreads = unsafePerformIO $ newTVarIO 0
+
+speculateQSize :: TVar Int
+speculateQSize = unsafePerformIO $ newTVarIO 0
+
+speculateQ :: Chan (String,FilePath)
+speculateQ = unsafePerformIO newChan
 
 postUrl
   :: String -- ^ url
diff --git a/src/Darcs/Util/Hash.hs b/src/Darcs/Util/Hash.hs
index 7b7187a1..4eaa2a86 100644
--- a/src/Darcs/Util/Hash.hs
+++ b/src/Darcs/Util/Hash.hs
@@ -3,10 +3,11 @@
 
 module Darcs.Util.Hash
     ( Hash(..)
-    , encodeBase16, decodeBase16, sha256, sha256strict, sha256sum, rawHash, mkHash
-    , match, encodeHash, decodeHash, showHash
+    , encodeBase16, decodeBase16, sha256, sha256strict, sha256sum
+    , rawHash, mkHash
+    , match, encodeHash, decodeHash, showHash, formatHash
     -- SHA1 related (patch metadata hash)
-    , sha1PS, SHA1(..), showAsHex, sha1Xor, sha1zero, sha1short
+    , sha1, sha1PS, SHA1(..), showAsHex, sha1Xor, sha1zero, sha1short
     , sha1Show, sha1Read
  ) where
 
@@ -19,6 +20,7 @@ import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Short as BS
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Base16 as B16
+import Darcs.Util.Format ( Format, listWord8Hex )
 
 import qualified Crypto.Hash as H
 
@@ -40,6 +42,9 @@ decodeHash = decodeBase16 . BC.pack
 encodeHash :: Hash -> String
 encodeHash = BC.unpack . encodeBase16
 
+formatHash :: Hash -> Format
+formatHash (SHA256 bs) = listWord8Hex (BS.unpack bs)
+
 -- | Produce a base16 (ascii-hex) encoded string from a hash. This can be
 -- turned back into a Hash (see "decodeBase16". This is a loss-less process.
 encodeBase16 :: Hash -> B.ByteString
@@ -99,6 +104,9 @@ sha1zero = SHA1 0 0 0 0 0
 sha1short :: SHA1 -> Word32
 sha1short (SHA1 a _ _ _ _) = a
 
+sha1:: BL.ByteString -> SHA1
+sha1 bits = decode (BL.fromStrict (convert (H.hashlazy bits :: H.Digest H.SHA1)))
+
 sha1PS:: B.ByteString -> SHA1
 sha1PS = fromArray . convert . H.hashWith H.SHA1 where
   fromArray = decode . BL.fromStrict
diff --git a/src/Darcs/Util/Lock.hs b/src/Darcs/Util/Lock.hs
index 850d6b77..90928301 100644
--- a/src/Darcs/Util/Lock.hs
+++ b/src/Darcs/Util/Lock.hs
@@ -25,14 +25,15 @@ module Darcs.Util.Lock
     , withNamedTemp
     , writeBinFile
     , writeTextFile
+    , writeFormatBinFile
     , writeDocBinFile
-    , appendBinFile
-    , appendTextFile
     , appendDocBinFile
+    , appendFormatBinFile
     , readBinFile
     , readTextFile
     , readDocBinFile
     , writeAtomicFilePS
+    , gzWriteAtomicFile
     , gzWriteAtomicFilePS
     , gzWriteAtomicFilePSs
     , gzWriteDocFile
@@ -78,7 +79,6 @@ import System.Directory
     , renameDirectory
     )
 import System.FilePath.Posix ( splitDirectories, splitFileName )
-import System.Directory ( withCurrentDirectory )
 import System.Environment ( lookupEnv )
 import System.IO.Temp ( createTempDirectory )
 
@@ -100,8 +100,10 @@ import Darcs.Util.File ( removeFileMayNotExist )
 import Darcs.Util.Path ( AbsolutePath, FilePathLike, toFilePath,
                         getCurrentDirectory, setCurrentDirectory )
 
-import Darcs.Util.ByteString ( gzWriteFilePSs )
+import Darcs.Util.ByteString ( gzWriteFile, gzWriteFilePSs )
 import qualified Data.ByteString as B (null, readFile, hPut, ByteString)
+import qualified Data.ByteString.Lazy as BL ( ByteString )
+import Darcs.Util.Format (Format, hPutFormat)
 
 import Darcs.Util.SignalHandler ( withSignalsBlocked )
 import Darcs.Util.Printer ( Doc, hPutDoc, packedString, empty, renderPSs )
@@ -304,15 +306,12 @@ readDocBinFile :: FilePathLike p => p -> IO Doc
 readDocBinFile fp = do ps <- B.readFile $ toFilePath fp
                        return $ if B.null ps then empty else packedString ps
 
-appendBinFile :: FilePathLike p => p -> B.ByteString -> IO ()
-appendBinFile f s = appendToFile Binary f $ \h -> B.hPut h s
-
-appendTextFile :: FilePathLike p => p -> String -> IO ()
-appendTextFile f s = appendToFile Text f $ \h -> hPutStr h s
-
 appendDocBinFile :: FilePathLike p => p -> Doc -> IO ()
 appendDocBinFile f d = appendToFile Binary f $ \h -> hPutDoc h d
 
+appendFormatBinFile :: FilePathLike p => p -> Format -> IO ()
+appendFormatBinFile f d = appendToFile Binary f $ \h -> hPutFormat h d
+
 data FileType = Text | Binary
 
 writeBinFile :: FilePathLike p => p -> B.ByteString -> IO ()
@@ -326,43 +325,48 @@ writeTextFile f s = writeToFile Text f $ \h -> do
 writeDocBinFile :: FilePathLike p => p -> Doc -> IO ()
 writeDocBinFile f d = writeToFile Binary f $ \h -> hPutDoc h d
 
+writeFormatBinFile :: FilePathLike p => p -> Format -> IO ()
+writeFormatBinFile f d = writeToFile Binary f $ \h -> hPutFormat h d
+
 writeAtomicFilePS :: FilePathLike p => p -> B.ByteString -> IO ()
 writeAtomicFilePS f ps = writeToFile Binary f $ \h -> B.hPut h ps
 
+gzWriteAtomicFile :: FilePathLike p => p -> BL.ByteString -> IO ()
+gzWriteAtomicFile f s = atomicWrite (toFilePath f) (flip gzWriteFile s)
+
 gzWriteAtomicFilePS :: FilePathLike p => p -> B.ByteString -> IO ()
 gzWriteAtomicFilePS f ps = gzWriteAtomicFilePSs f [ps]
 
 gzWriteAtomicFilePSs :: FilePathLike p => p -> [B.ByteString] -> IO ()
-gzWriteAtomicFilePSs f pss =
-    withSignalsBlocked $ withNamedTemp (toFilePath f) $ \newf -> do
-    gzWriteFilePSs newf pss
-    already_exists <- doesFileExist $ toFilePath f
-    when already_exists $ do mode <- fileMode `fmap` getFileStatus (toFilePath f)
-                             setFileMode newf mode
-             `catchall` return ()
-    renameFile newf (toFilePath f)
+gzWriteAtomicFilePSs f pss = atomicWrite (toFilePath f) (flip gzWriteFilePSs pss)
 
 gzWriteDocFile :: FilePathLike p => p -> Doc -> IO ()
 gzWriteDocFile f d = gzWriteAtomicFilePSs f $ renderPSs d
 
 writeToFile :: FilePathLike p => FileType -> p -> (Handle -> IO ()) -> IO ()
 writeToFile t f job =
-    withSignalsBlocked $ withNamedTemp (toFilePath f) $ \newf -> do
+  atomicWrite (toFilePath f) $ \temp -> do
     (case t of
       Text -> withFile
-      Binary -> withBinaryFile) newf WriteMode job
-    already_exists <- doesFileExist (toFilePath f)
-    when already_exists $ do mode <- fileMode `fmap` getFileStatus (toFilePath f)
-                             setFileMode newf mode
-             `catchall` return ()
-    renameFile newf (toFilePath f)
+      Binary -> withBinaryFile) temp WriteMode job
 
 appendToFile :: FilePathLike p => FileType -> p -> (Handle -> IO ()) -> IO ()
-appendToFile t f job = withSignalsBlocked $
+appendToFile t f job =
+  withSignalsBlocked $
     (case t of
       Binary -> withBinaryFile
       Text -> withFile) (toFilePath f) AppendMode job
 
+atomicWrite :: FilePath -> (FilePath -> IO ()) -> IO ()
+atomicWrite dest write = do
+  withSignalsBlocked $ withNamedTemp dest $ \temp -> do
+    write temp
+    already_exists <- doesFileExist dest
+    when already_exists $ do
+      mode <- fileMode `fmap` getFileStatus dest
+      setFileMode temp mode
+     `catchall` return ()
+    renameFile temp dest
 
 addToErrorLoc :: IOException
               -> String
@@ -370,11 +374,14 @@ addToErrorLoc :: IOException
 addToErrorLoc ioe s = annotateIOError ioe s Nothing Nothing
 
 -- | Do an action in a newly created directory of the given name. If the
--- directory is successfully created but the action raises an exception, the
--- directory and all its content is deleted. Caught exceptions are re-thrown.
+-- directory is successfully created but the action raises an exception, change
+-- back to the current directory and delete the directory and all its content,
+-- re-throwing the exceptions. Otherwise stay in the new directory.
 withNewDirectory :: FilePath -> IO () -> IO ()
 withNewDirectory name action = do
   createDirectory name
-  withCurrentDirectory name action `catch` \e -> do
+  old <- getCurrentDirectory
+  (setCurrentDirectory name >> action) `catch` \e -> do
+    setCurrentDirectory old
     removePathForcibly name `catchIOError` const (return ())
     throwIO (e :: SomeException)
diff --git a/src/Darcs/Util/ObjectStore.hs b/src/Darcs/Util/ObjectStore.hs
new file mode 100644
index 00000000..aaf6c5de
--- /dev/null
+++ b/src/Darcs/Util/ObjectStore.hs
@@ -0,0 +1,273 @@
+--  Copyright (C) 2009-2011 Petr Rockai
+--
+--  BSD3
+{-# LANGUAGE ParallelListComp #-}
+
+-- | This module implements an "object storage". This is a directory on disk
+-- containing a content-addressed storage. This is useful for storing all kinds
+-- of things, particularly filesystem trees, or darcs pristine caches and patch
+-- objects. However, this is an abstract, flat storage: no tree semantics are
+-- provided. You just need to provide a reference-collecting functionality,
+-- computing a list of references for any given object. The system provides
+-- transparent garbage collection and packing.
+module Darcs.Util.ObjectStore
+  ( Format(..)
+  , Block
+  , OS
+    -- * Basic operations.
+  , hatch
+  , compact
+  , repack
+  , lookup
+    -- * Creating and loading.
+  , create
+  , load
+    -- * Low-level.
+  , format
+  , blockLookup
+  , live
+  , hatchery
+  , mature
+  , roots
+  , references
+  , rootdir
+  ) where
+
+import Prelude hiding ((<$>), lookup, read)
+
+import Control.Applicative ( (<$>) )
+import Control.Monad ( forM, forM_ )
+
+import Data.Binary ( decode, encode )
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Short as BS
+import Data.Int ( Int64 )
+import Data.List ( sort )
+import qualified Data.Map as M
+import Data.Maybe ( catMaybes, isNothing, listToMaybe )
+import qualified Data.Set as S
+
+import System.Directory
+    ( createDirectoryIfMissing
+    , doesFileExist
+    , getDirectoryContents
+    , removeFile
+    )
+import System.FilePath ( (<.>), (</>) )
+import System.Posix.Files ( isDirectory )
+
+import Darcs.Util.File ( getFileStatus )
+import Darcs.Util.Hash
+import Darcs.Util.ObjectStore.Utils
+
+-- | On-disk format for object storage: we implement a completely loose format
+-- (one file per object), a compact format stored in a single append-only file
+-- and an immutable \"pack\" format.
+data Format
+  = Loose
+  | Compact
+  | Pack
+  deriving (Show, Eq)
+
+loose_dirs :: [[Char]]
+loose_dirs =
+  let chars = ['0' .. '9'] ++ ['a' .. 'f']
+   in [[a, b] | a <- chars, b <- chars]
+
+loosePath :: OS -> Hash -> FilePath
+loosePath os hash =
+  let hash' = BC.unpack (encodeBase16 hash)
+   in rootdir os </> "hatchery" </> take 2 hash' </> drop 2 hash'
+
+looseLookup :: OS -> Hash -> IO (Maybe FileSegment)
+looseLookup os hash = do
+  let path = loosePath os hash
+  exist <- doesFileExist path
+  return $ if exist then Just (path, Nothing) else Nothing
+
+-- | Object storage block. When used as a hatchery, the loose or compact format
+-- are preferable, while for mature space, the pack format is more useful.
+data Block = Block
+  { blockLookup :: Hash -> IO (Maybe FileSegment)
+  , size :: Int64
+  , format :: Format
+  }
+
+-- | Object storage. Contains a single \"hatchery\" and possibly a number of
+-- mature space blocks, usually in form of packs. It also keeps a list of root
+-- pointers and has a way to extract pointers from objects (externally
+-- supplied). These last two things are used to implement a simple GC.
+data OS = OS
+  { hatchery :: Block
+  , mature :: [Block]
+  , roots :: [Hash]
+  , references :: FileSegment -> IO [Hash]
+  , rootdir :: FilePath
+  }
+
+-- | Reduce number of packs in the object storage. This may both recombine
+-- packs to eliminate dead objects and join some packs to form bigger packs.
+repack :: OS -> IO OS
+repack _ = error "repack undefined"
+
+-- | Add new objects to the object storage (i.e. put them into hatchery). It is
+-- safe to call this even on objects that are already present in the storage:
+-- such objects will be skipped.
+hatch :: OS -> [BL.ByteString] -> IO OS
+hatch os blobs = do
+  processed <- mapM sieve blobs
+  write [(h, b) | (True, h, b) <- processed]
+  where
+    write bits =
+      case format (hatchery os) of
+        Loose -> do
+          _ <- forM bits $ \(hash, blob) -> BL.writeFile (loosePath os hash) blob
+          return os
+        Compact -> error "hatch/compact undefined"
+        _ -> fail "Hatchery must be either Loose or Compact."
+    sieve blob = do
+      let hash = sha256 blob
+      absent <- isNothing <$> lookup os hash
+      return (absent, hash, blob)
+
+-- | Move things from hatchery into a (new) pack.
+compact :: OS -> IO OS
+compact os = do
+  objects <- live os [hatchery os]
+  block <- createPack os (M.toList objects)
+  cleanup
+  return $ os {mature = block : mature os}
+  where
+    cleanup =
+      case format (hatchery os) of
+        Loose -> forM_ loose_dirs $ nuke . ((rootdir os </> "hatchery") </>)
+        Compact -> removeFile (rootdir os </> "hatchery") >> return ()
+        _ -> fail "Hatchery must be either Loose or Compact."
+    nuke dir =
+      mapM (removeFile . (dir </>)) =<<
+      (Prelude.filter (`notElem` [".", ".."]) `fmap` getDirectoryContents dir)
+
+blocksLookup :: [Block] -> Hash -> IO (Maybe (Hash, FileSegment))
+blocksLookup blocks hash = do
+  segment <- cat `fmap` mapM (flip blockLookup hash) blocks
+  return $
+    case segment of
+      Nothing -> Nothing
+      Just seg -> Just (hash, seg)
+  where
+    cat = listToMaybe . catMaybes
+
+lookup :: OS -> Hash -> IO (Maybe FileSegment)
+lookup os hash = do
+  res <- blocksLookup (hatchery os : mature os) hash
+  return $
+    case res of
+      Nothing -> Nothing
+      Just (_, seg) -> Just seg
+
+-- | Create an empty object storage in given directory, with a hatchery of
+-- given format. The directory is created if needed, but is assumed to be
+-- empty.
+create :: FilePath -> Format -> IO OS
+create path fmt = do
+  createDirectoryIfMissing True path
+  _ <- initHatchery
+  load path
+  where
+    initHatchery
+      | fmt == Loose = do
+        mkdir hatchpath
+        forM loose_dirs $ mkdir . (hatchpath </>)
+      | fmt == Compact = error "create/mkHatchery Compact undefined"
+      | otherwise = error "create/mkHatchery Pack undefined"
+    mkdir = createDirectoryIfMissing False
+    hatchpath = path </> "hatchery"
+
+load :: FilePath -> IO OS
+load rootdir = do
+  have_hatch <- getFileStatus $ rootdir </> "hatchery"
+  case have_hatch of
+    Nothing -> fail $ rootdir ++ " does not exist!"
+    Just hatch_stat -> do
+      let is_dir = isDirectory hatch_stat
+          hatchery =
+            Block
+              { blockLookup = look os
+              , format = if is_dir then Loose else Compact
+              , size = undefined
+              }
+          references = undefined
+          look
+            | format hatchery == Loose = looseLookup
+            | otherwise = undefined
+          mature = [] -- FIXME read packs
+          roots = [] -- FIXME read root pointers
+          os = OS {..}
+      return os
+
+readPack :: FilePath -> IO Block
+readPack file = do
+  bits <- readSegment (file, Nothing)
+  let count = decode (BL.take 8 $ bits)
+      lookup_ hash first final = do
+        let middle = first + ((final - first) `div` 2)
+            rawhash = rawHash hash
+        res <-
+          case ( compare rawhash (hashof first)
+               , compare rawhash (hashof middle)
+               , compare rawhash (hashof final)) of
+            (LT, _, _) -> return Nothing
+            (_, _, GT) -> return Nothing
+            (EQ, _, _) -> return $ Just (segof first)
+            (_, _, EQ) -> return $ Just (segof final)
+            (GT, EQ, LT) -> return $ Just (segof middle)
+            (GT, GT, LT)
+              | middle /= final -> lookup_ hash middle final
+            (GT, LT, LT)
+              | first /= middle -> lookup_ hash first middle
+            (_, _, _) -> return Nothing
+        return res
+      headerof i = BL.take 51 $ BL.drop (8 + i * 51) bits
+      hashof i = BC.concat $ BL.toChunks $ BL.take 32 $ headerof i
+      segof i = (file, Just (count * 51 + 8 + from, sz))
+        where
+          from = decode (BL.take 8 $ BL.drop 33 $ headerof i)
+          sz = decode (BL.take 8 $ BL.drop 42 $ headerof i)
+  return $
+    Block
+      { size = BL.length bits
+      , format = Pack
+      , blockLookup = \h -> lookup_ h 0 (count - 1)
+      }
+
+createPack :: OS -> [(Hash, FileSegment)] -> IO Block
+createPack os bits = do
+  contents <- mapM readSegment (map snd bits)
+  let offsets = scanl (+) 0 $ map BL.length contents
+      headerbits =
+        [ BL.concat
+            [ BL.fromChunks [BS.fromShort rawhash]
+            , packAscii "@"
+            , encode offset
+            , packAscii "!"
+            , encode $ BL.length string
+            , packAscii "\n"
+            ]
+        | (SHA256 rawhash, _) <- bits
+        | string <- contents
+        | offset <- offsets
+        ]
+      header = BL.concat $ (encode $ length bits) : sort headerbits
+      blob = BL.concat $ header : contents
+      hash = sha256 blob
+      path = rootdir os </> BC.unpack (encodeBase16 hash) <.> "bin"
+      packAscii = BL.fromStrict . BC.pack
+  BL.writeFile path blob
+  readPack path
+
+-- | Build a map of live objects (i.e. those reachable from the given roots) in
+-- a given list of Blocks.
+live :: OS -> [Block] -> IO (M.Map Hash FileSegment)
+live os blocks =
+  reachable (references os) (blocksLookup blocks) (S.fromList $ roots os)
diff --git a/src/Darcs/Util/ObjectStore/Utils.hs b/src/Darcs/Util/ObjectStore/Utils.hs
new file mode 100644
index 00000000..a7b26d30
--- /dev/null
+++ b/src/Darcs/Util/ObjectStore/Utils.hs
@@ -0,0 +1,83 @@
+--  Copyright (C) 2009-2011 Petr Rockai
+--
+--  BSD3
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
+
+-- | Mostly internal utilities for use by the rest of the library. Subject to
+-- removal without further notice.
+module Darcs.Util.ObjectStore.Utils
+    ( FileSegment
+    , readSegment
+    , reachable
+    ) where
+
+import Darcs.Prelude
+
+import Control.Exception ( SomeException(..), catch )
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS8
+import qualified Data.ByteString.Lazy.Char8 as BL
+import Data.Int ( Int64 )
+import qualified Data.Map as M
+import Data.Maybe ( catMaybes )
+import qualified Data.Set as S
+
+import System.IO ( IOMode(ReadMode), SeekMode(AbsoluteSeek), hSeek, withFile )
+import System.Mem ( performGC )
+import System.Posix.Files ( fileSize, getFileStatus )
+
+-- | Pointer to a file, possibly with start/end offsets. Supposed to be
+-- fed to (uncurry mmapFileByteString) or similar.
+type FileSegment = (FilePath, Maybe (Int64, Int))
+
+-- | Read in a FileSegment into a Lazy ByteString. Implemented using mmap.
+readSegment :: FileSegment -> IO BL.ByteString
+readSegment (f, range) = do
+  bs <-
+    tryToRead `catch` \(_ :: SomeException) -> do
+      size <- fileSize `fmap` getFileStatus f
+      if size == 0
+        then return BS8.empty
+        else performGC >> tryToRead
+  return $ BL.fromChunks [bs]
+  where
+    tryToRead = do
+      case range of
+        Nothing -> BS.readFile f
+        Just (off, size) ->
+          withFile f ReadMode $ \h -> do
+            hSeek h AbsoluteSeek $ fromIntegral off
+            BS.hGet h size
+
+{-# INLINE readSegment #-}
+-- | Find a monadic fixed point of @f@ that is the least above @i@. (Will
+-- happily diverge if there is none.)
+mfixFrom :: (Eq a, Monad m) => (a -> m a) -> a -> m a
+mfixFrom f i = do
+  x <- f i
+  if x == i
+    then return i
+    else mfixFrom f x
+
+-- | For a @refs@ function, a @map@ (@key@ -> @value@) and a @rootSet@, find a
+-- submap of @map@ such that all items in @map@ are reachable, through @refs@
+-- from @rootSet@.
+reachable
+  :: forall monad key value
+   . (Monad monad, Ord key, Eq value)
+  => (value -> monad [key])
+  -> (key -> monad (Maybe (key, value)))
+  -> S.Set key
+  -> monad (M.Map key value)
+reachable refs lookup rootSet = do
+  lookupSet rootSet >>= mfixFrom expand
+  where
+    lookupSet :: S.Set key -> monad (M.Map key value)
+    expand :: M.Map key value -> monad (M.Map key value)
+    lookupSet s = do
+      list <- mapM lookup (S.toAscList s)
+      return $ M.fromAscList (catMaybes list)
+    expand from = do
+      refd <- concat <$> mapM refs (M.elems from)
+      M.union from <$> lookupSet (S.fromList refd)
diff --git a/src/Darcs/Util/Parser.hs b/src/Darcs/Util/Parser.hs
index 3988bec4..67f89d0f 100644
--- a/src/Darcs/Util/Parser.hs
+++ b/src/Darcs/Util/Parser.hs
@@ -98,6 +98,9 @@ unsigned :: Integral a => Parser a
 unsigned = lex decimal
 
 {-# INLINE takeTillChar #-}
+-- | This function as well as 'takeTill' (on which it is based) both
+-- succeed when we hit end-of-input. So a more correct name would
+-- be 'takeTillCharOrEOF' (and 'takeTillOrEOF', respectively).
 takeTillChar :: Char -> Parser B.ByteString
 takeTillChar c = takeTill (== c)
 
diff --git a/src/Darcs/Util/Path.hs b/src/Darcs/Util/Path.hs
index 0c715445..4d090dbc 100644
--- a/src/Darcs/Util/Path.hs
+++ b/src/Darcs/Util/Path.hs
@@ -121,39 +121,37 @@ displayPath p
 
 -- | Interpret an 'AnchoredPath' as relative the current working
 -- directory. Intended for IO operations in the file system.
--- Use with care!
+-- This returns the empty string for the root, so use with care!
 realPath :: AnchoredPath -> FilePath
 realPath = anchorPath ""
 
--- | 'encodeWhite' translates whitespace in filenames to a darcs-specific
---   format (numerical representation according to 'ord' surrounded by
---   backslashes).  Note that backslashes are also escaped since they are used
---   in the encoding.
+-- | Encode whitespace and backslashes in filenames to a darcs-specific
+-- format (numerical representation according to 'ord' surrounded by
+-- backslashes).
 --
 --   > encodeWhite "hello there" == "hello\32\there"
 --   > encodeWhite "hello\there" == "hello\92\there"
 encodeWhite :: FilePath -> String
-encodeWhite (c:cs) | isSpace c || c == '\\' =
-    '\\' : show (ord c) ++ "\\" ++ encodeWhite cs
-encodeWhite (c:cs) = c : encodeWhite cs
-encodeWhite [] = []
+encodeWhite = foldr encodesWhiteChar [] where
+  encodesWhiteChar c acc
+    | isSpace c || c == '\\' = '\\' : show (ord c) ++ '\\' : acc
+    | otherwise = c : acc
 
--- | 'decodeWhite' interprets the Darcs-specific \"encoded\" filenames
---   produced by 'encodeWhite'
+-- | Decode filenames from the darcs-specific encoding produced by
+-- 'encodeWhite'.
 --
 --   > decodeWhite "hello\32\there"  == Right "hello there"
 --   > decodeWhite "hello\92\there"  == Right "hello\there"
 --   > decodeWhite "hello\there"   == Left "malformed filename"
 decodeWhite :: String -> Either String FilePath
-decodeWhite cs_ = go cs_ [] False
- where go "" acc True  = Right (reverse acc) -- if there was a replace, use new string
-       go "" _   False = Right cs_         -- if not, use input string
-       go ('\\':cs) acc _ =
-         case break (=='\\') cs of
-           (theord, '\\':rest) ->
-             go rest (chr (read theord) :acc) True
-           _ -> Left $ "malformed filename: " ++ cs_
-       go (c:cs) acc modified = go cs (c:acc) modified
+decodeWhite s = go s where
+  go [] = return []
+  go (c:cs)
+    | c == '\\' =
+      case break (== '\\') cs of
+        (theord, '\\':rest) -> (chr (read theord) :) <$> go rest
+        _ -> Left $ "malformed filename: " ++ s
+    | otherwise = (c :) <$> go cs
 
 class FilePathOrURL a where
   toPath :: a -> String
@@ -496,7 +494,7 @@ forbiddenNames :: [B.ByteString]
 forbiddenNames = [BC.empty, BC.pack ".", BC.pack ".."]
 
 hasPathSeparator :: B.ByteString -> Bool
-hasPathSeparator = BC.elem '/'
+hasPathSeparator x = any (`BC.elem` x) NativeFilePath.pathSeparators
 
 eqAnycase :: Name -> Name -> Bool
 eqAnycase (Name a) (Name b) = BS.map to_lower a == BS.map to_lower b
diff --git a/src/Darcs/Util/Printer.hs b/src/Darcs/Util/Printer.hs
index 047f192f..9b1427c3 100644
--- a/src/Darcs/Util/Printer.hs
+++ b/src/Darcs/Util/Printer.hs
@@ -6,12 +6,13 @@
 -- This code was made generic in the element type by Juliusz Chroboczek.
 module Darcs.Util.Printer
     (
+    -- * Class 'Print'
+    Print(..)
     -- * 'Doc' type and structural combinators
-      Doc(Doc,unDoc)
+    , Doc(Doc,unDoc)
     , empty, (<>), (<?>), (<+>), ($$), ($+$), vcat, vsep, hcat, hsep
-    , minus, newline, plus, space, backslash, lparen, rparen
-    , parens, sentence
     -- * Constructing 'Doc's
+    , newline
     , text
     , hiddenText
     , invisibleText
@@ -22,7 +23,6 @@ module Darcs.Util.Printer
     , userchunk, packedString
     , prefix
     , hiddenPrefix
-    , prefixLines
     , invisiblePS, userchunkPS
     , fromXml
     -- * Rendering to 'String'
@@ -37,8 +37,6 @@ module Darcs.Util.Printer
     , simplePrinters, invisiblePrinter, simplePrinter
     -- * Printables
     , Printable(..)
-    , doc
-    , printable, invisiblePrintable, hiddenPrintable, userchunkPrintable
     -- * Constructing colored 'Doc's
     , Color(..)
     , blueText, redText, greenText, magentaText, cyanText
@@ -62,9 +60,19 @@ import qualified Data.ByteString as B ( ByteString, hPut, concat )
 import qualified Data.ByteString.Char8 as BC ( singleton )
 import qualified Text.XML.Light as XML
 
-import Darcs.Util.ByteString ( linesPS, decodeLocale, encodeLocale, gzWriteHandle )
+import Darcs.Util.ByteString ( decodeLocale, encodeLocale, gzWriteHandle )
 import Darcs.Util.Global ( debugMessage )
 
+
+class Print a where
+  print :: a -> Doc
+
+instance (Print a, Print b) => Print (a, b) where
+  print (a, b) = print a $$ print b
+
+instance Print () where
+  print () = empty
+
 -- | A 'Printable' is either a String, a packed string, or a chunk of
 -- text with both representations.
 data Printable = S !String
@@ -79,42 +87,10 @@ spaceP   = Both " "  (BC.singleton ' ')
 newlineP :: Printable
 newlineP = S "\n"
 
--- | A 'Doc' representing a space (\" \")
-space :: Doc
-space = unsafeBoth " "  (BC.singleton ' ')
-
 -- | A 'Doc' representing a newline
 newline :: Doc
 newline = unsafeChar '\n'
 
--- | A 'Doc' representing a \"-\"
-minus :: Doc
-minus = unsafeBoth "-"  (BC.singleton '-')
-
--- | A 'Doc' representing a \"+\"
-plus :: Doc
-plus = unsafeBoth "+"  (BC.singleton '+')
-
--- | A 'Doc' representing a \"\\\"
-backslash :: Doc
-backslash = unsafeBoth "\\" (BC.singleton '\\')
-
--- | A 'Doc' that represents @\"(\"@
-lparen :: Doc
-lparen = unsafeBoth  "(" (BC.singleton '(')
-
--- | A 'Doc' that represents @\")\"@
-rparen :: Doc
-rparen = unsafeBoth ")" (BC.singleton ')')
-
--- | prop> parens d = lparen <> d <> rparen
-parens :: Doc -> Doc
-parens d = lparen <> d <> rparen
-
--- | Turn a 'Doc' into a sentence. This appends a ".".
-sentence :: Doc -> Doc
-sentence = (<> text ".")
-
 -- | Format a list of 'FilePath's as quoted text. It deliberately refuses to
 -- use English.andClauses but rather separates the quoted strings only with a
 -- space, because this makes it usable for copy and paste e.g. as arguments to
@@ -269,12 +245,6 @@ prefix s (Doc d) = Doc $ \st ->
                      Document d'' -> Document $ (p:) . d''
                      Empty -> Empty
 
--- TODO try to find another way to do this, it's rather a violation
--- of the Doc abstraction
-prefixLines :: Doc -> Doc -> Doc
-prefixLines prefixer prefixee =
-  vcat $ map (prefixer <+>) $ map packedString $ linesPS $ renderPS prefixee
-
 lineColor :: Color -> Doc -> Doc
 lineColor c d = Doc $ \st -> case lineColorT (printers st) c d of
                              Doc d' -> d' st
diff --git a/src/Darcs/Util/Ssh.hs b/src/Darcs/Util/Ssh.hs
index 9d57fac4..2f05d396 100644
--- a/src/Darcs/Util/Ssh.hs
+++ b/src/Darcs/Util/Ssh.hs
@@ -40,8 +40,7 @@ import Control.Exception ( throwIO, catch, catchJust, SomeException )
 import Control.Monad ( forM_, unless, void, (>=>) )
 
 import qualified Data.ByteString as B (ByteString, hGet, writeFile )
-
-import Data.Map ( Map, empty, insert, lookup )
+import qualified Data.Map as M
 
 import System.IO ( Handle, hSetBinaryMode, hPutStrLn, hGetLine, hFlush )
 import System.IO.Unsafe ( unsafePerformIO )
@@ -145,8 +144,8 @@ type RepoId = (String, String) -- (user@host,repodir)
 -- (the repoid is not in the map). Once a connection fails,
 -- either when trying to establish it or during usage, it will not
 -- be tried again.
-sshConnections :: MVar (Map RepoId (Maybe (MVar Connection)))
-sshConnections = unsafePerformIO $ newMVar empty
+sshConnections :: MVar (M.Map RepoId (Maybe (MVar Connection)))
+sshConnections = unsafePerformIO $ newMVar M.empty
 {-# NOINLINE sshConnections #-}
 
 -- | Wait for an existing connection to become available or, if none
@@ -156,18 +155,18 @@ getSshConnection :: String                       -- ^ remote darcs command
                  -> IO (Maybe (MVar Connection)) -- ^ wrapper for the action
 getSshConnection rdarcs sshfp = modifyMVar sshConnections $ \cmap -> do
   let key = repoid sshfp
-  case lookup key cmap of
+  case M.lookup key cmap of
     Nothing -> do
       -- we have not yet tried with this key, do it now
       mc <- newSshConnection rdarcs sshfp
       case mc of
         Nothing ->
           -- failed, remember it, so we don't try again
-          return (insert key Nothing cmap, Nothing)
+          return (M.insert key Nothing cmap, Nothing)
         Just c -> do
           -- success, remember and use
           v <- newMVar c
-          return (insert key (Just v) cmap, Just v)
+          return (M.insert key (Just v) cmap, Just v)
     Just Nothing ->
       -- we have tried to connect before, don't do it again
       return (cmap, Nothing)
@@ -214,14 +213,14 @@ resetSshConnections =
           terminateProcess ph
           void $ waitForProcess ph
       Nothing -> return ()
-    return empty
+    return M.empty
 
 -- | Mark any connection associated with the given ssh file path
 -- as failed, so it won't be tried again.
 dropSshConnection :: RepoId -> IO ()
 dropSshConnection key = do
   debugMessage $ "Dropping ssh failed connection to " ++ fst key ++ ":" ++ snd key
-  modifyMVar_ sshConnections (return . insert key Nothing)
+  modifyMVar_ sshConnections (return . M.insert key Nothing)
 
 repoid :: SshFilePath -> RepoId
 repoid sshfp = (sshUhost sshfp, sshRepo sshfp)
@@ -255,12 +254,13 @@ grabSSH src c = do
 copySSH :: String -> SshFilePath -> FilePath -> IO ()
 copySSH rdarcs src dest = do
   debugMessage $ "copySSH file: " ++ sshFilePathOf src
-  -- TODO why do we disable progress reporting here?
-  withoutProgress $ do
-    mc <- getSshConnection rdarcs src
-    case mc of
-      Just v -> withMVar v (grabSSH src >=> B.writeFile dest)
-      Nothing -> do
+  mc <- getSshConnection rdarcs src
+  case mc of
+    Just v -> withMVar v (grabSSH src >=> B.writeFile dest)
+    Nothing ->
+      -- disable progress reporting because child inherits stdout
+      -- TODO check if we can avoid that
+      withoutProgress $ do
         -- remote 'darcs transfer-mode' does not work => use scp
         let u = escape_dollar $ sshFilePathOf src
         (scpcmd, args) <- getSSH SCP
diff --git a/src/Darcs/Util/Tree/Diff.hs b/src/Darcs/Util/Tree/Diff.hs
new file mode 100644
index 00000000..5b1e8ec0
--- /dev/null
+++ b/src/Darcs/Util/Tree/Diff.hs
@@ -0,0 +1,37 @@
+module Darcs.Util.Tree.Diff
+  ( TreeDiff(..)
+  , getTreeDiff
+  , organise
+  ) where
+
+import Darcs.Prelude
+import Darcs.Util.Tree (TreeItem(..))
+import Darcs.Util.Path (AnchoredPath)
+
+-- TODO this is isomorphic to These (TreeItem m)
+data TreeDiff m
+  = Added (TreeItem m)
+  | Removed (TreeItem m)
+  | Changed (TreeItem m)
+            (TreeItem m)
+
+getTreeDiff
+  :: AnchoredPath
+  -> Maybe (TreeItem m)
+  -> Maybe (TreeItem m)
+  -> (AnchoredPath, TreeDiff m)
+getTreeDiff p Nothing (Just t) = (p, Added t)
+getTreeDiff p (Just from) (Just to) = (p, Changed from to)
+getTreeDiff p (Just t) Nothing = (p, Removed t)
+getTreeDiff _ Nothing Nothing = error "impossible case" -- zipTrees should never return this
+
+-- sort into removes, changes, adds, with removes in reverse-path order
+-- and everything else in forward order
+organise :: (AnchoredPath, TreeDiff m) -> (AnchoredPath, TreeDiff m) -> Ordering
+organise (p1, Changed _ _) (p2, Changed _ _) = compare p1 p2
+organise (p1, Added _) (p2, Added _) = compare p1 p2
+organise (p1, Removed _) (p2, Removed _) = compare p2 p1
+organise (_, Removed _) _ = LT
+organise _ (_, Removed _) = GT
+organise (_, Changed _ _) _ = LT
+organise _ (_, Changed _ _) = GT
diff --git a/src/Darcs/Util/Tree/Hashed.hs b/src/Darcs/Util/Tree/Hashed.hs
index 893a398e..5906ad22 100644
--- a/src/Darcs/Util/Tree/Hashed.hs
+++ b/src/Darcs/Util/Tree/Hashed.hs
@@ -27,6 +27,7 @@ module Darcs.Util.Tree.Hashed
 
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.Set as S
 
 import Data.List ( sortBy )
 import Data.Maybe ( fromMaybe )
@@ -38,9 +39,10 @@ import Darcs.Util.Cache
     , fetchFileUsingCache
     , writeFileUsingCache
     )
+import Darcs.Util.Format
 import Darcs.Util.Hash
     ( Hash
-    , encodeBase16
+    , formatHash
     , encodeHash
     , sha256
     , showHash
@@ -78,20 +80,20 @@ import Darcs.Util.ValidHash
 --
 
 -- Precondition: all (immediate) items in the tree have hashes
-darcsFormatDir :: Tree m -> BL.ByteString
+darcsFormatDir :: Tree m -> Format
 darcsFormatDir =
-  BL.fromChunks . map formatItem . sortBy cmp . listImmediate
+  mconcat . map formatItem . sortBy cmp . listImmediate
   where
     cmp (a, _) (b, _) = compare a b
-    formatItem (name, item) = BC.unlines
+    formatItem (name, item) = vcat
       [ case item of
-          File _ -> kwFile
-          _      -> kwDir
-      , encodeWhiteName name
+          File _ -> byteString kwFile
+          _      -> byteString kwDir
+      , byteString (encodeWhiteName name)
       , case itemHash item of
           Nothing -> error "precondition of darcsFormatDir"
-          Just h  -> encodeBase16 h
-      ]
+          Just h  -> formatHash h
+      ] <> newline
 
 darcsParseDir
   :: FilePath -> BC.ByteString -> Either String [(ItemType, Name, PristineHash)]
@@ -123,7 +125,7 @@ kwDir = BC.pack "directory:"
 
 -- | Compute a darcs-compatible hash value for a tree-like structure.
 darcsTreeHash :: Tree m -> Hash
-darcsTreeHash = sha256 . darcsFormatDir
+darcsTreeHash = sha256 . toLazyByteString . darcsFormatDir
 
 darcsUpdateDirHashes :: Tree m -> Tree m
 darcsUpdateDirHashes = updateSubtrees update
@@ -199,7 +201,7 @@ writeDarcsHashed tree' cache = do
   let items = list t
   sequence_ [readAndWriteBlob b | (_, File b) <- items]
   let dirs = darcsFormatDir t : [darcsFormatDir d | (_, SubTree d) <- items]
-  mapM_ dump dirs
+  mapM_ (dump . toLazyByteString) dirs
   return (fromHash (darcsTreeHash t))
   where
     readAndWriteBlob b = readBlob b >>= dump
@@ -208,8 +210,7 @@ writeDarcsHashed tree' cache = do
 -- | Create a hashed file from a 'Cache' and file content. In case the file
 -- exists it is kept untouched and is assumed to have the right content.
 fsCreateHashedFile :: Cache -> BL.ByteString -> IO PristineHash
-fsCreateHashedFile cache content =
-  writeFileUsingCache cache (BL.toStrict content)
+fsCreateHashedFile cache content = writeFileUsingCache cache content
 
 fsReadHashedFile :: Cache -> PristineHash -> IO (FilePath, BC.ByteString)
 fsReadHashedFile = fetchFileUsingCache
@@ -247,18 +248,21 @@ hashedTreeIO action tree cache = runTreeMonad action tree (const dumpItem)
     dumpTree t = do
       debugMessage $ "hashedTreeIO.dumpTree: old hash=" ++ showHash (treeHash t)
       t' <- darcsAddMissingHashes t
-      nhash <- fsCreateHashedFile cache (darcsFormatDir t')
+      nhash <- fsCreateHashedFile cache (toLazyByteString (darcsFormatDir t'))
       debugMessage $ "hashedTreeIO.dumpTree: new hash=" ++ encodeValidHash nhash
       return t'
 
 -- | Return all 'PristineHash'es reachable from the given root set, which must
 -- consist of directory hashes only.
 followPristineHashes :: Cache -> [PristineHash] -> IO [PristineHash]
-followPristineHashes cache = followAll
+followPristineHashes cache = fmap S.toList . follow S.empty
   where
-    followAll roots = concat <$> mapM followOne roots
-    followOne root = do
-      x <- readDarcsHashedDir cache root
-      let subs   = [ ph | (TreeType, _, ph) <- x ]
-          hashes = root : [ ph | (_, _, ph) <- x ]
-      (hashes ++) <$> followAll subs
+    follow done [] = return done
+    follow done (root:roots)
+      | root `S.member` done = follow done roots
+      | otherwise = do
+        x <- readDarcsHashedDir cache root
+        let subTrees = [ ph | (TreeType, _, ph) <- x ]
+            blobs    = [ ph | (BlobType, _, ph) <- x ]
+            done'    = done `S.union` S.fromList (root:blobs)
+        follow done' (subTrees ++ roots)
diff --git a/src/Darcs/Util/Index.hs b/src/Darcs/Util/Tree/Index.hs
similarity index 99%
rename from src/Darcs/Util/Index.hs
rename to src/Darcs/Util/Tree/Index.hs
index c50fa16e..cc113a83 100644
--- a/src/Darcs/Util/Index.hs
+++ b/src/Darcs/Util/Tree/Index.hs
@@ -96,7 +96,7 @@
 -- full path. We need to keep track of the current path anyway when traversing
 -- the index.
 
-module Darcs.Util.Index
+module Darcs.Util.Tree.Index
     ( openIndex
     , updateIndexFrom
     , indexFormatValid
diff --git a/src/Darcs/Util/Tree/Monad.hs b/src/Darcs/Util/Tree/Monad.hs
index b2b33b22..26a427f2 100644
--- a/src/Darcs/Util/Tree/Monad.hs
+++ b/src/Darcs/Util/Tree/Monad.hs
@@ -39,7 +39,13 @@ module Darcs.Util.Tree.Monad
 
 import Darcs.Prelude hiding ( readFile, writeFile )
 
-import Darcs.Util.Path ( AnchoredPath, anchoredRoot, displayPath, movedirfilename )
+import Darcs.Util.Path
+    ( AnchoredPath
+    , anchoredRoot
+    , displayPath
+    , isPrefix
+    , movedirfilename
+    )
 import Darcs.Util.Tree
 
 import Data.List( sortBy )
@@ -140,16 +146,6 @@ renameChanged from to = modify $ \st -> st {changed = rename' $ changed st}
   where
     rename' = M.mapKeys (movedirfilename from to)
 
--- | Replace an item with a new version without modifying the content of the
--- tree. This does not do any change tracking. Ought to be only used from a
--- 'sync' implementation for a particular storage format. The presumed use-case
--- is that an existing in-memory Blob is replaced with a one referring to an
--- on-disk file.
-replaceItem :: Monad m
-            => AnchoredPath -> TreeItem m -> TreeMonad m ()
-replaceItem path item = do
-  modify $ \st -> st { tree = modifyTree (tree st) path (Just item) }
-
 -- | Flush a single item to disk. This is the only procedure that (directly)
 -- uses the Reader part of the environment (the procedure of type @'DumpItem' m@).
 flushItem :: forall m . Monad m => AnchoredPath -> TreeMonad m ()
@@ -158,7 +154,10 @@ flushItem path = do
   dumpItem <- ask
   case find current path of
     Nothing -> return () -- vanished, do nothing
-    Just item -> lift (dumpItem path item) >>= replaceItem path
+    Just item -> do
+      let replaceItem item' =
+            modify $ \st -> st { tree = modifyTree current path (Just item') }
+      lift (dumpItem path item) >>= replaceItem
 
 -- | If buffers are becoming large, sync, otherwise do nothing.
 flushSome :: Monad m => TreeMonad m ()
@@ -269,6 +268,9 @@ rename from to = do
   unless (isNothing found_to) $
     throwM $
       mkIOError AlreadyExists "rename" Nothing (Just (displayPath to))
+  when (isPrefix from to) $
+    throwM $
+      mkIOError InvalidArgument "rename" Nothing (Just (displayPath to))
   modifyItem from Nothing
   modifyItem to item
   renameChanged from to
diff --git a/src/Darcs/Util/ValidHash.hs b/src/Darcs/Util/ValidHash.hs
index 8c248ffc..62048708 100644
--- a/src/Darcs/Util/ValidHash.hs
+++ b/src/Darcs/Util/ValidHash.hs
@@ -7,6 +7,7 @@ module Darcs.Util.ValidHash
     , encodeValidHash
     , decodeValidHash
     , parseValidHash
+    , formatValidHash
     , getHash
     , getSize
     , fromHash
@@ -16,13 +17,24 @@ module Darcs.Util.ValidHash
     ) where
 
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
 import Data.Maybe ( isJust )
+import Data.Int ( Int64 )
 import Text.Read ( readMaybe )
 
 import Prelude ( (^) )
 import Darcs.Prelude
 
-import Darcs.Util.Hash ( Hash, decodeBase16, decodeHash, encodeHash, sha256strict )
+import Darcs.Util.Format ( Format, ascii )
+import Darcs.Util.Hash
+    ( Hash
+    , decodeBase16
+    , decodeHash
+    , encodeHash
+    , formatHash
+    , sha256
+    , sha256strict
+    )
 import qualified Darcs.Util.Parser as P
 
 -- | Semantically, this is the type of hashed objects. Git has a type tag
@@ -39,33 +51,36 @@ class (Eq h, IsSizeHash h) => ValidHash h where
   -- | The 'HashedDir' belonging to this type of hash
   dirofValidHash :: h -> HashedDir
   -- | Compute hash from file content.
-  calcValidHash :: B.ByteString -> h
+  calcValidHash :: BL.ByteString -> h
   -- default definitions
-  calcValidHash content = fromSizeAndHash (B.length content) (sha256strict content)
+  calcValidHash content = fromSizeAndHash (BL.length content) (sha256 content)
 
 newtype InventoryHash = InventoryHash SizeHash
-  deriving (Eq, Show, IsSizeHash)
+  deriving (Eq, Ord, Show, IsSizeHash)
 
 instance ValidHash InventoryHash where
   dirofValidHash _ = HashedInventoriesDir
 
 newtype PatchHash = PatchHash SizeHash
-  deriving (Eq, Show, IsSizeHash)
+  deriving (Eq, Ord, Show, IsSizeHash)
 
 instance ValidHash PatchHash where
   dirofValidHash _ = HashedPatchesDir
 
 newtype PristineHash = PristineHash SizeHash
-  deriving (Eq, Show, IsSizeHash)
+  deriving (Eq, Ord, Show, IsSizeHash)
 
 instance ValidHash PristineHash where
   dirofValidHash _ = HashedPristineDir
   -- note: not the default definition here
-  calcValidHash = fromHash . sha256strict
+  calcValidHash = fromHash . sha256
 
 encodeValidHash :: ValidHash h => h -> String
 encodeValidHash = encodeSizeHash . getSizeHash
 
+formatValidHash :: ValidHash h => h -> Format
+formatValidHash = formatSizeHash . getSizeHash
+
 decodeValidHash :: ValidHash h => String -> Maybe h
 decodeValidHash = fmap fromSizeHash . decodeSizeHash
 
@@ -90,12 +105,14 @@ fromHash h = fromSizeHash (NoSize h)
 numSizeDigits :: Int
 numSizeDigits = 10
 
-sizeLimit :: Int
+sizeLimit :: Int64
 sizeLimit = 10 ^ numSizeDigits
 
-fromSizeAndHash :: ValidHash h => Int -> Hash -> h
+fromSizeAndHash :: ValidHash h => Int64 -> Hash -> h
 fromSizeAndHash size hash =
-  fromSizeHash $ if size < sizeLimit then WithSize size hash else NoSize hash
+  fromSizeHash $ if size < sizeLimit
+    then WithSize (fromIntegral size) hash
+    else NoSize hash
 
 -- | Check that the given 'String' is an encoding of some 'ValidHash'.
 okayHash :: String -> Bool
@@ -124,7 +141,7 @@ checkHash vh content =
 data SizeHash
   = WithSize !Int !Hash
   | NoSize !Hash
-  deriving (Eq, Show)
+  deriving (Eq, Ord, Show)
 
 -- | Methods to wrap and unwrap 'ValidHash'es
 class IsSizeHash h where
@@ -152,6 +169,12 @@ encodeSizeHash (WithSize size hash) =
     padZero (show size) ++ '-' : encodeHash hash
   where padZero s = replicate (numSizeDigits - length s) '0' ++ s
 
+formatSizeHash :: SizeHash -> Format
+formatSizeHash (NoSize hash) = formatHash hash
+formatSizeHash (WithSize size hash) =
+    ascii (padZero (show size)) <> ascii "-" <> formatHash hash
+  where padZero s = replicate (numSizeDigits - length s) '0' ++ s
+
 decodeSizeHash :: String -> Maybe SizeHash
 decodeSizeHash s =
   case splitAt numSizeDigits s of
@@ -162,7 +185,7 @@ decodeSizeHash s =
     decodeSize :: String -> Maybe Int
     decodeSize ss =
       case readMaybe ss of
-        Just size | size >= 0 && size < sizeLimit -> Just size
+        Just size | size >= 0 && size < sizeLimit -> Just (fromIntegral size)
         _ -> Nothing
 
 parseSizeHash :: P.Parser SizeHash
diff --git a/src/wcwidth9.h b/src/wcwidth9.h
new file mode 100644
index 00000000..edda890d
--- /dev/null
+++ b/src/wcwidth9.h
@@ -0,0 +1,1326 @@
+/*
+ * Copied from https://github.com/joshuarubin/wcwidth9 (commit 17e14929)
+ * License: see https://github.com/joshuarubin/wcwidth9/blob/master/LICENSE
+ */
+#ifndef WCWIDTH9_H
+#define WCWIDTH9_H
+
+#include <stdlib.h>
+#include <stdbool.h>
+
+struct wcwidth9_interval {
+  long first;
+  long last;
+};
+
+static const struct wcwidth9_interval wcwidth9_private[] = {
+  {0x00e000, 0x00f8ff},
+  {0x0f0000, 0x0ffffd},
+  {0x100000, 0x10fffd},
+};
+
+static const struct wcwidth9_interval wcwidth9_nonprint[] = {
+  {0x0000, 0x001f},
+  {0x007f, 0x009f},
+  {0x00ad, 0x00ad},
+  {0x070f, 0x070f},
+  {0x180b, 0x180e},
+  {0x200b, 0x200f},
+  {0x2028, 0x2029},
+  {0x202a, 0x202e},
+  {0x206a, 0x206f},
+  {0xd800, 0xdfff},
+  {0xfeff, 0xfeff},
+  {0xfff9, 0xfffb},
+  {0xfffe, 0xffff},
+};
+
+static const struct wcwidth9_interval wcwidth9_combining[] = {
+  {0x0300, 0x036f},
+  {0x0483, 0x0489},
+  {0x0591, 0x05bd},
+  {0x05bf, 0x05bf},
+  {0x05c1, 0x05c2},
+  {0x05c4, 0x05c5},
+  {0x05c7, 0x05c7},
+  {0x0610, 0x061a},
+  {0x064b, 0x065f},
+  {0x0670, 0x0670},
+  {0x06d6, 0x06dc},
+  {0x06df, 0x06e4},
+  {0x06e7, 0x06e8},
+  {0x06ea, 0x06ed},
+  {0x0711, 0x0711},
+  {0x0730, 0x074a},
+  {0x07a6, 0x07b0},
+  {0x07eb, 0x07f3},
+  {0x0816, 0x0819},
+  {0x081b, 0x0823},
+  {0x0825, 0x0827},
+  {0x0829, 0x082d},
+  {0x0859, 0x085b},
+  {0x08d4, 0x08e1},
+  {0x08e3, 0x0903},
+  {0x093a, 0x093c},
+  {0x093e, 0x094f},
+  {0x0951, 0x0957},
+  {0x0962, 0x0963},
+  {0x0981, 0x0983},
+  {0x09bc, 0x09bc},
+  {0x09be, 0x09c4},
+  {0x09c7, 0x09c8},
+  {0x09cb, 0x09cd},
+  {0x09d7, 0x09d7},
+  {0x09e2, 0x09e3},
+  {0x0a01, 0x0a03},
+  {0x0a3c, 0x0a3c},
+  {0x0a3e, 0x0a42},
+  {0x0a47, 0x0a48},
+  {0x0a4b, 0x0a4d},
+  {0x0a51, 0x0a51},
+  {0x0a70, 0x0a71},
+  {0x0a75, 0x0a75},
+  {0x0a81, 0x0a83},
+  {0x0abc, 0x0abc},
+  {0x0abe, 0x0ac5},
+  {0x0ac7, 0x0ac9},
+  {0x0acb, 0x0acd},
+  {0x0ae2, 0x0ae3},
+  {0x0b01, 0x0b03},
+  {0x0b3c, 0x0b3c},
+  {0x0b3e, 0x0b44},
+  {0x0b47, 0x0b48},
+  {0x0b4b, 0x0b4d},
+  {0x0b56, 0x0b57},
+  {0x0b62, 0x0b63},
+  {0x0b82, 0x0b82},
+  {0x0bbe, 0x0bc2},
+  {0x0bc6, 0x0bc8},
+  {0x0bca, 0x0bcd},
+  {0x0bd7, 0x0bd7},
+  {0x0c00, 0x0c03},
+  {0x0c3e, 0x0c44},
+  {0x0c46, 0x0c48},
+  {0x0c4a, 0x0c4d},
+  {0x0c55, 0x0c56},
+  {0x0c62, 0x0c63},
+  {0x0c81, 0x0c83},
+  {0x0cbc, 0x0cbc},
+  {0x0cbe, 0x0cc4},
+  {0x0cc6, 0x0cc8},
+  {0x0cca, 0x0ccd},
+  {0x0cd5, 0x0cd6},
+  {0x0ce2, 0x0ce3},
+  {0x0d01, 0x0d03},
+  {0x0d3e, 0x0d44},
+  {0x0d46, 0x0d48},
+  {0x0d4a, 0x0d4d},
+  {0x0d57, 0x0d57},
+  {0x0d62, 0x0d63},
+  {0x0d82, 0x0d83},
+  {0x0dca, 0x0dca},
+  {0x0dcf, 0x0dd4},
+  {0x0dd6, 0x0dd6},
+  {0x0dd8, 0x0ddf},
+  {0x0df2, 0x0df3},
+  {0x0e31, 0x0e31},
+  {0x0e34, 0x0e3a},
+  {0x0e47, 0x0e4e},
+  {0x0eb1, 0x0eb1},
+  {0x0eb4, 0x0eb9},
+  {0x0ebb, 0x0ebc},
+  {0x0ec8, 0x0ecd},
+  {0x0f18, 0x0f19},
+  {0x0f35, 0x0f35},
+  {0x0f37, 0x0f37},
+  {0x0f39, 0x0f39},
+  {0x0f3e, 0x0f3f},
+  {0x0f71, 0x0f84},
+  {0x0f86, 0x0f87},
+  {0x0f8d, 0x0f97},
+  {0x0f99, 0x0fbc},
+  {0x0fc6, 0x0fc6},
+  {0x102b, 0x103e},
+  {0x1056, 0x1059},
+  {0x105e, 0x1060},
+  {0x1062, 0x1064},
+  {0x1067, 0x106d},
+  {0x1071, 0x1074},
+  {0x1082, 0x108d},
+  {0x108f, 0x108f},
+  {0x109a, 0x109d},
+  {0x135d, 0x135f},
+  {0x1712, 0x1714},
+  {0x1732, 0x1734},
+  {0x1752, 0x1753},
+  {0x1772, 0x1773},
+  {0x17b4, 0x17d3},
+  {0x17dd, 0x17dd},
+  {0x180b, 0x180d},
+  {0x1885, 0x1886},
+  {0x18a9, 0x18a9},
+  {0x1920, 0x192b},
+  {0x1930, 0x193b},
+  {0x1a17, 0x1a1b},
+  {0x1a55, 0x1a5e},
+  {0x1a60, 0x1a7c},
+  {0x1a7f, 0x1a7f},
+  {0x1ab0, 0x1abe},
+  {0x1b00, 0x1b04},
+  {0x1b34, 0x1b44},
+  {0x1b6b, 0x1b73},
+  {0x1b80, 0x1b82},
+  {0x1ba1, 0x1bad},
+  {0x1be6, 0x1bf3},
+  {0x1c24, 0x1c37},
+  {0x1cd0, 0x1cd2},
+  {0x1cd4, 0x1ce8},
+  {0x1ced, 0x1ced},
+  {0x1cf2, 0x1cf4},
+  {0x1cf8, 0x1cf9},
+  {0x1dc0, 0x1df5},
+  {0x1dfb, 0x1dff},
+  {0x20d0, 0x20f0},
+  {0x2cef, 0x2cf1},
+  {0x2d7f, 0x2d7f},
+  {0x2de0, 0x2dff},
+  {0x302a, 0x302f},
+  {0x3099, 0x309a},
+  {0xa66f, 0xa672},
+  {0xa674, 0xa67d},
+  {0xa69e, 0xa69f},
+  {0xa6f0, 0xa6f1},
+  {0xa802, 0xa802},
+  {0xa806, 0xa806},
+  {0xa80b, 0xa80b},
+  {0xa823, 0xa827},
+  {0xa880, 0xa881},
+  {0xa8b4, 0xa8c5},
+  {0xa8e0, 0xa8f1},
+  {0xa926, 0xa92d},
+  {0xa947, 0xa953},
+  {0xa980, 0xa983},
+  {0xa9b3, 0xa9c0},
+  {0xa9e5, 0xa9e5},
+  {0xaa29, 0xaa36},
+  {0xaa43, 0xaa43},
+  {0xaa4c, 0xaa4d},
+  {0xaa7b, 0xaa7d},
+  {0xaab0, 0xaab0},
+  {0xaab2, 0xaab4},
+  {0xaab7, 0xaab8},
+  {0xaabe, 0xaabf},
+  {0xaac1, 0xaac1},
+  {0xaaeb, 0xaaef},
+  {0xaaf5, 0xaaf6},
+  {0xabe3, 0xabea},
+  {0xabec, 0xabed},
+  {0xfb1e, 0xfb1e},
+  {0xfe00, 0xfe0f},
+  {0xfe20, 0xfe2f},
+  {0x101fd, 0x101fd},
+  {0x102e0, 0x102e0},
+  {0x10376, 0x1037a},
+  {0x10a01, 0x10a03},
+  {0x10a05, 0x10a06},
+  {0x10a0c, 0x10a0f},
+  {0x10a38, 0x10a3a},
+  {0x10a3f, 0x10a3f},
+  {0x10ae5, 0x10ae6},
+  {0x11000, 0x11002},
+  {0x11038, 0x11046},
+  {0x1107f, 0x11082},
+  {0x110b0, 0x110ba},
+  {0x11100, 0x11102},
+  {0x11127, 0x11134},
+  {0x11173, 0x11173},
+  {0x11180, 0x11182},
+  {0x111b3, 0x111c0},
+  {0x111ca, 0x111cc},
+  {0x1122c, 0x11237},
+  {0x1123e, 0x1123e},
+  {0x112df, 0x112ea},
+  {0x11300, 0x11303},
+  {0x1133c, 0x1133c},
+  {0x1133e, 0x11344},
+  {0x11347, 0x11348},
+  {0x1134b, 0x1134d},
+  {0x11357, 0x11357},
+  {0x11362, 0x11363},
+  {0x11366, 0x1136c},
+  {0x11370, 0x11374},
+  {0x11435, 0x11446},
+  {0x114b0, 0x114c3},
+  {0x115af, 0x115b5},
+  {0x115b8, 0x115c0},
+  {0x115dc, 0x115dd},
+  {0x11630, 0x11640},
+  {0x116ab, 0x116b7},
+  {0x1171d, 0x1172b},
+  {0x11c2f, 0x11c36},
+  {0x11c38, 0x11c3f},
+  {0x11c92, 0x11ca7},
+  {0x11ca9, 0x11cb6},
+  {0x16af0, 0x16af4},
+  {0x16b30, 0x16b36},
+  {0x16f51, 0x16f7e},
+  {0x16f8f, 0x16f92},
+  {0x1bc9d, 0x1bc9e},
+  {0x1d165, 0x1d169},
+  {0x1d16d, 0x1d172},
+  {0x1d17b, 0x1d182},
+  {0x1d185, 0x1d18b},
+  {0x1d1aa, 0x1d1ad},
+  {0x1d242, 0x1d244},
+  {0x1da00, 0x1da36},
+  {0x1da3b, 0x1da6c},
+  {0x1da75, 0x1da75},
+  {0x1da84, 0x1da84},
+  {0x1da9b, 0x1da9f},
+  {0x1daa1, 0x1daaf},
+  {0x1e000, 0x1e006},
+  {0x1e008, 0x1e018},
+  {0x1e01b, 0x1e021},
+  {0x1e023, 0x1e024},
+  {0x1e026, 0x1e02a},
+  {0x1e8d0, 0x1e8d6},
+  {0x1e944, 0x1e94a},
+  {0xe0100, 0xe01ef},
+};
+
+static const struct wcwidth9_interval wcwidth9_doublewidth[] = {
+  {0x1100, 0x115f},
+  {0x231a, 0x231b},
+  {0x2329, 0x232a},
+  {0x23e9, 0x23ec},
+  {0x23f0, 0x23f0},
+  {0x23f3, 0x23f3},
+  {0x25fd, 0x25fe},
+  {0x2614, 0x2615},
+  {0x2648, 0x2653},
+  {0x267f, 0x267f},
+  {0x2693, 0x2693},
+  {0x26a1, 0x26a1},
+  {0x26aa, 0x26ab},
+  {0x26bd, 0x26be},
+  {0x26c4, 0x26c5},
+  {0x26ce, 0x26ce},
+  {0x26d4, 0x26d4},
+  {0x26ea, 0x26ea},
+  {0x26f2, 0x26f3},
+  {0x26f5, 0x26f5},
+  {0x26fa, 0x26fa},
+  {0x26fd, 0x26fd},
+  {0x2705, 0x2705},
+  {0x270a, 0x270b},
+  {0x2728, 0x2728},
+  {0x274c, 0x274c},
+  {0x274e, 0x274e},
+  {0x2753, 0x2755},
+  {0x2757, 0x2757},
+  {0x2795, 0x2797},
+  {0x27b0, 0x27b0},
+  {0x27bf, 0x27bf},
+  {0x2b1b, 0x2b1c},
+  {0x2b50, 0x2b50},
+  {0x2b55, 0x2b55},
+  {0x2e80, 0x2e99},
+  {0x2e9b, 0x2ef3},
+  {0x2f00, 0x2fd5},
+  {0x2ff0, 0x2ffb},
+  {0x3000, 0x303e},
+  {0x3041, 0x3096},
+  {0x3099, 0x30ff},
+  {0x3105, 0x312d},
+  {0x3131, 0x318e},
+  {0x3190, 0x31ba},
+  {0x31c0, 0x31e3},
+  {0x31f0, 0x321e},
+  {0x3220, 0x3247},
+  {0x3250, 0x32fe},
+  {0x3300, 0x4dbf},
+  {0x4e00, 0xa48c},
+  {0xa490, 0xa4c6},
+  {0xa960, 0xa97c},
+  {0xac00, 0xd7a3},
+  {0xf900, 0xfaff},
+  {0xfe10, 0xfe19},
+  {0xfe30, 0xfe52},
+  {0xfe54, 0xfe66},
+  {0xfe68, 0xfe6b},
+  {0xff01, 0xff60},
+  {0xffe0, 0xffe6},
+  {0x16fe0, 0x16fe0},
+  {0x17000, 0x187ec},
+  {0x18800, 0x18af2},
+  {0x1b000, 0x1b001},
+  {0x1f004, 0x1f004},
+  {0x1f0cf, 0x1f0cf},
+  {0x1f18e, 0x1f18e},
+  {0x1f191, 0x1f19a},
+  {0x1f200, 0x1f202},
+  {0x1f210, 0x1f23b},
+  {0x1f240, 0x1f248},
+  {0x1f250, 0x1f251},
+  {0x1f300, 0x1f320},
+  {0x1f32d, 0x1f335},
+  {0x1f337, 0x1f37c},
+  {0x1f37e, 0x1f393},
+  {0x1f3a0, 0x1f3ca},
+  {0x1f3cf, 0x1f3d3},
+  {0x1f3e0, 0x1f3f0},
+  {0x1f3f4, 0x1f3f4},
+  {0x1f3f8, 0x1f43e},
+  {0x1f440, 0x1f440},
+  {0x1f442, 0x1f4fc},
+  {0x1f4ff, 0x1f53d},
+  {0x1f54b, 0x1f54e},
+  {0x1f550, 0x1f567},
+  {0x1f57a, 0x1f57a},
+  {0x1f595, 0x1f596},
+  {0x1f5a4, 0x1f5a4},
+  {0x1f5fb, 0x1f64f},
+  {0x1f680, 0x1f6c5},
+  {0x1f6cc, 0x1f6cc},
+  {0x1f6d0, 0x1f6d2},
+  {0x1f6eb, 0x1f6ec},
+  {0x1f6f4, 0x1f6f6},
+  {0x1f910, 0x1f91e},
+  {0x1f920, 0x1f927},
+  {0x1f930, 0x1f930},
+  {0x1f933, 0x1f93e},
+  {0x1f940, 0x1f94b},
+  {0x1f950, 0x1f95e},
+  {0x1f980, 0x1f991},
+  {0x1f9c0, 0x1f9c0},
+  {0x20000, 0x2fffd},
+  {0x30000, 0x3fffd},
+};
+
+static const struct wcwidth9_interval wcwidth9_ambiguous[] = {
+  {0x00a1, 0x00a1},
+  {0x00a4, 0x00a4},
+  {0x00a7, 0x00a8},
+  {0x00aa, 0x00aa},
+  {0x00ad, 0x00ae},
+  {0x00b0, 0x00b4},
+  {0x00b6, 0x00ba},
+  {0x00bc, 0x00bf},
+  {0x00c6, 0x00c6},
+  {0x00d0, 0x00d0},
+  {0x00d7, 0x00d8},
+  {0x00de, 0x00e1},
+  {0x00e6, 0x00e6},
+  {0x00e8, 0x00ea},
+  {0x00ec, 0x00ed},
+  {0x00f0, 0x00f0},
+  {0x00f2, 0x00f3},
+  {0x00f7, 0x00fa},
+  {0x00fc, 0x00fc},
+  {0x00fe, 0x00fe},
+  {0x0101, 0x0101},
+  {0x0111, 0x0111},
+  {0x0113, 0x0113},
+  {0x011b, 0x011b},
+  {0x0126, 0x0127},
+  {0x012b, 0x012b},
+  {0x0131, 0x0133},
+  {0x0138, 0x0138},
+  {0x013f, 0x0142},
+  {0x0144, 0x0144},
+  {0x0148, 0x014b},
+  {0x014d, 0x014d},
+  {0x0152, 0x0153},
+  {0x0166, 0x0167},
+  {0x016b, 0x016b},
+  {0x01ce, 0x01ce},
+  {0x01d0, 0x01d0},
+  {0x01d2, 0x01d2},
+  {0x01d4, 0x01d4},
+  {0x01d6, 0x01d6},
+  {0x01d8, 0x01d8},
+  {0x01da, 0x01da},
+  {0x01dc, 0x01dc},
+  {0x0251, 0x0251},
+  {0x0261, 0x0261},
+  {0x02c4, 0x02c4},
+  {0x02c7, 0x02c7},
+  {0x02c9, 0x02cb},
+  {0x02cd, 0x02cd},
+  {0x02d0, 0x02d0},
+  {0x02d8, 0x02db},
+  {0x02dd, 0x02dd},
+  {0x02df, 0x02df},
+  {0x0300, 0x036f},
+  {0x0391, 0x03a1},
+  {0x03a3, 0x03a9},
+  {0x03b1, 0x03c1},
+  {0x03c3, 0x03c9},
+  {0x0401, 0x0401},
+  {0x0410, 0x044f},
+  {0x0451, 0x0451},
+  {0x2010, 0x2010},
+  {0x2013, 0x2016},
+  {0x2018, 0x2019},
+  {0x201c, 0x201d},
+  {0x2020, 0x2022},
+  {0x2024, 0x2027},
+  {0x2030, 0x2030},
+  {0x2032, 0x2033},
+  {0x2035, 0x2035},
+  {0x203b, 0x203b},
+  {0x203e, 0x203e},
+  {0x2074, 0x2074},
+  {0x207f, 0x207f},
+  {0x2081, 0x2084},
+  {0x20ac, 0x20ac},
+  {0x2103, 0x2103},
+  {0x2105, 0x2105},
+  {0x2109, 0x2109},
+  {0x2113, 0x2113},
+  {0x2116, 0x2116},
+  {0x2121, 0x2122},
+  {0x2126, 0x2126},
+  {0x212b, 0x212b},
+  {0x2153, 0x2154},
+  {0x215b, 0x215e},
+  {0x2160, 0x216b},
+  {0x2170, 0x2179},
+  {0x2189, 0x2189},
+  {0x2190, 0x2199},
+  {0x21b8, 0x21b9},
+  {0x21d2, 0x21d2},
+  {0x21d4, 0x21d4},
+  {0x21e7, 0x21e7},
+  {0x2200, 0x2200},
+  {0x2202, 0x2203},
+  {0x2207, 0x2208},
+  {0x220b, 0x220b},
+  {0x220f, 0x220f},
+  {0x2211, 0x2211},
+  {0x2215, 0x2215},
+  {0x221a, 0x221a},
+  {0x221d, 0x2220},
+  {0x2223, 0x2223},
+  {0x2225, 0x2225},
+  {0x2227, 0x222c},
+  {0x222e, 0x222e},
+  {0x2234, 0x2237},
+  {0x223c, 0x223d},
+  {0x2248, 0x2248},
+  {0x224c, 0x224c},
+  {0x2252, 0x2252},
+  {0x2260, 0x2261},
+  {0x2264, 0x2267},
+  {0x226a, 0x226b},
+  {0x226e, 0x226f},
+  {0x2282, 0x2283},
+  {0x2286, 0x2287},
+  {0x2295, 0x2295},
+  {0x2299, 0x2299},
+  {0x22a5, 0x22a5},
+  {0x22bf, 0x22bf},
+  {0x2312, 0x2312},
+  {0x2460, 0x24e9},
+  {0x24eb, 0x254b},
+  {0x2550, 0x2573},
+  {0x2580, 0x258f},
+  {0x2592, 0x2595},
+  {0x25a0, 0x25a1},
+  {0x25a3, 0x25a9},
+  {0x25b2, 0x25b3},
+  {0x25b6, 0x25b7},
+  {0x25bc, 0x25bd},
+  {0x25c0, 0x25c1},
+  {0x25c6, 0x25c8},
+  {0x25cb, 0x25cb},
+  {0x25ce, 0x25d1},
+  {0x25e2, 0x25e5},
+  {0x25ef, 0x25ef},
+  {0x2605, 0x2606},
+  {0x2609, 0x2609},
+  {0x260e, 0x260f},
+  {0x261c, 0x261c},
+  {0x261e, 0x261e},
+  {0x2640, 0x2640},
+  {0x2642, 0x2642},
+  {0x2660, 0x2661},
+  {0x2663, 0x2665},
+  {0x2667, 0x266a},
+  {0x266c, 0x266d},
+  {0x266f, 0x266f},
+  {0x269e, 0x269f},
+  {0x26bf, 0x26bf},
+  {0x26c6, 0x26cd},
+  {0x26cf, 0x26d3},
+  {0x26d5, 0x26e1},
+  {0x26e3, 0x26e3},
+  {0x26e8, 0x26e9},
+  {0x26eb, 0x26f1},
+  {0x26f4, 0x26f4},
+  {0x26f6, 0x26f9},
+  {0x26fb, 0x26fc},
+  {0x26fe, 0x26ff},
+  {0x273d, 0x273d},
+  {0x2776, 0x277f},
+  {0x2b56, 0x2b59},
+  {0x3248, 0x324f},
+  {0xe000, 0xf8ff},
+  {0xfe00, 0xfe0f},
+  {0xfffd, 0xfffd},
+  {0x1f100, 0x1f10a},
+  {0x1f110, 0x1f12d},
+  {0x1f130, 0x1f169},
+  {0x1f170, 0x1f18d},
+  {0x1f18f, 0x1f190},
+  {0x1f19b, 0x1f1ac},
+  {0xe0100, 0xe01ef},
+  {0xf0000, 0xffffd},
+  {0x100000, 0x10fffd},
+};
+
+static const struct wcwidth9_interval wcwidth9_emoji_width[] = {
+  {0x1f1e6, 0x1f1ff},
+  {0x1f321, 0x1f321},
+  {0x1f324, 0x1f32c},
+  {0x1f336, 0x1f336},
+  {0x1f37d, 0x1f37d},
+  {0x1f396, 0x1f397},
+  {0x1f399, 0x1f39b},
+  {0x1f39e, 0x1f39f},
+  {0x1f3cb, 0x1f3ce},
+  {0x1f3d4, 0x1f3df},
+  {0x1f3f3, 0x1f3f5},
+  {0x1f3f7, 0x1f3f7},
+  {0x1f43f, 0x1f43f},
+  {0x1f441, 0x1f441},
+  {0x1f4fd, 0x1f4fd},
+  {0x1f549, 0x1f54a},
+  {0x1f56f, 0x1f570},
+  {0x1f573, 0x1f579},
+  {0x1f587, 0x1f587},
+  {0x1f58a, 0x1f58d},
+  {0x1f590, 0x1f590},
+  {0x1f5a5, 0x1f5a5},
+  {0x1f5a8, 0x1f5a8},
+  {0x1f5b1, 0x1f5b2},
+  {0x1f5bc, 0x1f5bc},
+  {0x1f5c2, 0x1f5c4},
+  {0x1f5d1, 0x1f5d3},
+  {0x1f5dc, 0x1f5de},
+  {0x1f5e1, 0x1f5e1},
+  {0x1f5e3, 0x1f5e3},
+  {0x1f5e8, 0x1f5e8},
+  {0x1f5ef, 0x1f5ef},
+  {0x1f5f3, 0x1f5f3},
+  {0x1f5fa, 0x1f5fa},
+  {0x1f6cb, 0x1f6cf},
+  {0x1f6e0, 0x1f6e5},
+  {0x1f6e9, 0x1f6e9},
+  {0x1f6f0, 0x1f6f0},
+  {0x1f6f3, 0x1f6f3},
+};
+
+static const struct wcwidth9_interval wcwidth9_not_assigned[] = {
+  {0x0378, 0x0379},
+  {0x0380, 0x0383},
+  {0x038b, 0x038b},
+  {0x038d, 0x038d},
+  {0x03a2, 0x03a2},
+  {0x0530, 0x0530},
+  {0x0557, 0x0558},
+  {0x0560, 0x0560},
+  {0x0588, 0x0588},
+  {0x058b, 0x058c},
+  {0x0590, 0x0590},
+  {0x05c8, 0x05cf},
+  {0x05eb, 0x05ef},
+  {0x05f5, 0x05ff},
+  {0x061d, 0x061d},
+  {0x070e, 0x070e},
+  {0x074b, 0x074c},
+  {0x07b2, 0x07bf},
+  {0x07fb, 0x07ff},
+  {0x082e, 0x082f},
+  {0x083f, 0x083f},
+  {0x085c, 0x085d},
+  {0x085f, 0x089f},
+  {0x08b5, 0x08b5},
+  {0x08be, 0x08d3},
+  {0x0984, 0x0984},
+  {0x098d, 0x098e},
+  {0x0991, 0x0992},
+  {0x09a9, 0x09a9},
+  {0x09b1, 0x09b1},
+  {0x09b3, 0x09b5},
+  {0x09ba, 0x09bb},
+  {0x09c5, 0x09c6},
+  {0x09c9, 0x09ca},
+  {0x09cf, 0x09d6},
+  {0x09d8, 0x09db},
+  {0x09de, 0x09de},
+  {0x09e4, 0x09e5},
+  {0x09fc, 0x0a00},
+  {0x0a04, 0x0a04},
+  {0x0a0b, 0x0a0e},
+  {0x0a11, 0x0a12},
+  {0x0a29, 0x0a29},
+  {0x0a31, 0x0a31},
+  {0x0a34, 0x0a34},
+  {0x0a37, 0x0a37},
+  {0x0a3a, 0x0a3b},
+  {0x0a3d, 0x0a3d},
+  {0x0a43, 0x0a46},
+  {0x0a49, 0x0a4a},
+  {0x0a4e, 0x0a50},
+  {0x0a52, 0x0a58},
+  {0x0a5d, 0x0a5d},
+  {0x0a5f, 0x0a65},
+  {0x0a76, 0x0a80},
+  {0x0a84, 0x0a84},
+  {0x0a8e, 0x0a8e},
+  {0x0a92, 0x0a92},
+  {0x0aa9, 0x0aa9},
+  {0x0ab1, 0x0ab1},
+  {0x0ab4, 0x0ab4},
+  {0x0aba, 0x0abb},
+  {0x0ac6, 0x0ac6},
+  {0x0aca, 0x0aca},
+  {0x0ace, 0x0acf},
+  {0x0ad1, 0x0adf},
+  {0x0ae4, 0x0ae5},
+  {0x0af2, 0x0af8},
+  {0x0afa, 0x0b00},
+  {0x0b04, 0x0b04},
+  {0x0b0d, 0x0b0e},
+  {0x0b11, 0x0b12},
+  {0x0b29, 0x0b29},
+  {0x0b31, 0x0b31},
+  {0x0b34, 0x0b34},
+  {0x0b3a, 0x0b3b},
+  {0x0b45, 0x0b46},
+  {0x0b49, 0x0b4a},
+  {0x0b4e, 0x0b55},
+  {0x0b58, 0x0b5b},
+  {0x0b5e, 0x0b5e},
+  {0x0b64, 0x0b65},
+  {0x0b78, 0x0b81},
+  {0x0b84, 0x0b84},
+  {0x0b8b, 0x0b8d},
+  {0x0b91, 0x0b91},
+  {0x0b96, 0x0b98},
+  {0x0b9b, 0x0b9b},
+  {0x0b9d, 0x0b9d},
+  {0x0ba0, 0x0ba2},
+  {0x0ba5, 0x0ba7},
+  {0x0bab, 0x0bad},
+  {0x0bba, 0x0bbd},
+  {0x0bc3, 0x0bc5},
+  {0x0bc9, 0x0bc9},
+  {0x0bce, 0x0bcf},
+  {0x0bd1, 0x0bd6},
+  {0x0bd8, 0x0be5},
+  {0x0bfb, 0x0bff},
+  {0x0c04, 0x0c04},
+  {0x0c0d, 0x0c0d},
+  {0x0c11, 0x0c11},
+  {0x0c29, 0x0c29},
+  {0x0c3a, 0x0c3c},
+  {0x0c45, 0x0c45},
+  {0x0c49, 0x0c49},
+  {0x0c4e, 0x0c54},
+  {0x0c57, 0x0c57},
+  {0x0c5b, 0x0c5f},
+  {0x0c64, 0x0c65},
+  {0x0c70, 0x0c77},
+  {0x0c84, 0x0c84},
+  {0x0c8d, 0x0c8d},
+  {0x0c91, 0x0c91},
+  {0x0ca9, 0x0ca9},
+  {0x0cb4, 0x0cb4},
+  {0x0cba, 0x0cbb},
+  {0x0cc5, 0x0cc5},
+  {0x0cc9, 0x0cc9},
+  {0x0cce, 0x0cd4},
+  {0x0cd7, 0x0cdd},
+  {0x0cdf, 0x0cdf},
+  {0x0ce4, 0x0ce5},
+  {0x0cf0, 0x0cf0},
+  {0x0cf3, 0x0d00},
+  {0x0d04, 0x0d04},
+  {0x0d0d, 0x0d0d},
+  {0x0d11, 0x0d11},
+  {0x0d3b, 0x0d3c},
+  {0x0d45, 0x0d45},
+  {0x0d49, 0x0d49},
+  {0x0d50, 0x0d53},
+  {0x0d64, 0x0d65},
+  {0x0d80, 0x0d81},
+  {0x0d84, 0x0d84},
+  {0x0d97, 0x0d99},
+  {0x0db2, 0x0db2},
+  {0x0dbc, 0x0dbc},
+  {0x0dbe, 0x0dbf},
+  {0x0dc7, 0x0dc9},
+  {0x0dcb, 0x0dce},
+  {0x0dd5, 0x0dd5},
+  {0x0dd7, 0x0dd7},
+  {0x0de0, 0x0de5},
+  {0x0df0, 0x0df1},
+  {0x0df5, 0x0e00},
+  {0x0e3b, 0x0e3e},
+  {0x0e5c, 0x0e80},
+  {0x0e83, 0x0e83},
+  {0x0e85, 0x0e86},
+  {0x0e89, 0x0e89},
+  {0x0e8b, 0x0e8c},
+  {0x0e8e, 0x0e93},
+  {0x0e98, 0x0e98},
+  {0x0ea0, 0x0ea0},
+  {0x0ea4, 0x0ea4},
+  {0x0ea6, 0x0ea6},
+  {0x0ea8, 0x0ea9},
+  {0x0eac, 0x0eac},
+  {0x0eba, 0x0eba},
+  {0x0ebe, 0x0ebf},
+  {0x0ec5, 0x0ec5},
+  {0x0ec7, 0x0ec7},
+  {0x0ece, 0x0ecf},
+  {0x0eda, 0x0edb},
+  {0x0ee0, 0x0eff},
+  {0x0f48, 0x0f48},
+  {0x0f6d, 0x0f70},
+  {0x0f98, 0x0f98},
+  {0x0fbd, 0x0fbd},
+  {0x0fcd, 0x0fcd},
+  {0x0fdb, 0x0fff},
+  {0x10c6, 0x10c6},
+  {0x10c8, 0x10cc},
+  {0x10ce, 0x10cf},
+  {0x1249, 0x1249},
+  {0x124e, 0x124f},
+  {0x1257, 0x1257},
+  {0x1259, 0x1259},
+  {0x125e, 0x125f},
+  {0x1289, 0x1289},
+  {0x128e, 0x128f},
+  {0x12b1, 0x12b1},
+  {0x12b6, 0x12b7},
+  {0x12bf, 0x12bf},
+  {0x12c1, 0x12c1},
+  {0x12c6, 0x12c7},
+  {0x12d7, 0x12d7},
+  {0x1311, 0x1311},
+  {0x1316, 0x1317},
+  {0x135b, 0x135c},
+  {0x137d, 0x137f},
+  {0x139a, 0x139f},
+  {0x13f6, 0x13f7},
+  {0x13fe, 0x13ff},
+  {0x169d, 0x169f},
+  {0x16f9, 0x16ff},
+  {0x170d, 0x170d},
+  {0x1715, 0x171f},
+  {0x1737, 0x173f},
+  {0x1754, 0x175f},
+  {0x176d, 0x176d},
+  {0x1771, 0x1771},
+  {0x1774, 0x177f},
+  {0x17de, 0x17df},
+  {0x17ea, 0x17ef},
+  {0x17fa, 0x17ff},
+  {0x180f, 0x180f},
+  {0x181a, 0x181f},
+  {0x1878, 0x187f},
+  {0x18ab, 0x18af},
+  {0x18f6, 0x18ff},
+  {0x191f, 0x191f},
+  {0x192c, 0x192f},
+  {0x193c, 0x193f},
+  {0x1941, 0x1943},
+  {0x196e, 0x196f},
+  {0x1975, 0x197f},
+  {0x19ac, 0x19af},
+  {0x19ca, 0x19cf},
+  {0x19db, 0x19dd},
+  {0x1a1c, 0x1a1d},
+  {0x1a5f, 0x1a5f},
+  {0x1a7d, 0x1a7e},
+  {0x1a8a, 0x1a8f},
+  {0x1a9a, 0x1a9f},
+  {0x1aae, 0x1aaf},
+  {0x1abf, 0x1aff},
+  {0x1b4c, 0x1b4f},
+  {0x1b7d, 0x1b7f},
+  {0x1bf4, 0x1bfb},
+  {0x1c38, 0x1c3a},
+  {0x1c4a, 0x1c4c},
+  {0x1c89, 0x1cbf},
+  {0x1cc8, 0x1ccf},
+  {0x1cf7, 0x1cf7},
+  {0x1cfa, 0x1cff},
+  {0x1df6, 0x1dfa},
+  {0x1f16, 0x1f17},
+  {0x1f1e, 0x1f1f},
+  {0x1f46, 0x1f47},
+  {0x1f4e, 0x1f4f},
+  {0x1f58, 0x1f58},
+  {0x1f5a, 0x1f5a},
+  {0x1f5c, 0x1f5c},
+  {0x1f5e, 0x1f5e},
+  {0x1f7e, 0x1f7f},
+  {0x1fb5, 0x1fb5},
+  {0x1fc5, 0x1fc5},
+  {0x1fd4, 0x1fd5},
+  {0x1fdc, 0x1fdc},
+  {0x1ff0, 0x1ff1},
+  {0x1ff5, 0x1ff5},
+  {0x1fff, 0x1fff},
+  {0x2065, 0x2065},
+  {0x2072, 0x2073},
+  {0x208f, 0x208f},
+  {0x209d, 0x209f},
+  {0x20bf, 0x20cf},
+  {0x20f1, 0x20ff},
+  {0x218c, 0x218f},
+  {0x23ff, 0x23ff},
+  {0x2427, 0x243f},
+  {0x244b, 0x245f},
+  {0x2b74, 0x2b75},
+  {0x2b96, 0x2b97},
+  {0x2bba, 0x2bbc},
+  {0x2bc9, 0x2bc9},
+  {0x2bd2, 0x2beb},
+  {0x2bf0, 0x2bff},
+  {0x2c2f, 0x2c2f},
+  {0x2c5f, 0x2c5f},
+  {0x2cf4, 0x2cf8},
+  {0x2d26, 0x2d26},
+  {0x2d28, 0x2d2c},
+  {0x2d2e, 0x2d2f},
+  {0x2d68, 0x2d6e},
+  {0x2d71, 0x2d7e},
+  {0x2d97, 0x2d9f},
+  {0x2da7, 0x2da7},
+  {0x2daf, 0x2daf},
+  {0x2db7, 0x2db7},
+  {0x2dbf, 0x2dbf},
+  {0x2dc7, 0x2dc7},
+  {0x2dcf, 0x2dcf},
+  {0x2dd7, 0x2dd7},
+  {0x2ddf, 0x2ddf},
+  {0x2e45, 0x2e7f},
+  {0x2e9a, 0x2e9a},
+  {0x2ef4, 0x2eff},
+  {0x2fd6, 0x2fef},
+  {0x2ffc, 0x2fff},
+  {0x3040, 0x3040},
+  {0x3097, 0x3098},
+  {0x3100, 0x3104},
+  {0x312e, 0x3130},
+  {0x318f, 0x318f},
+  {0x31bb, 0x31bf},
+  {0x31e4, 0x31ef},
+  {0x321f, 0x321f},
+  {0x32ff, 0x32ff},
+  {0x4db6, 0x4dbf},
+  {0x9fd6, 0x9fff},
+  {0xa48d, 0xa48f},
+  {0xa4c7, 0xa4cf},
+  {0xa62c, 0xa63f},
+  {0xa6f8, 0xa6ff},
+  {0xa7af, 0xa7af},
+  {0xa7b8, 0xa7f6},
+  {0xa82c, 0xa82f},
+  {0xa83a, 0xa83f},
+  {0xa878, 0xa87f},
+  {0xa8c6, 0xa8cd},
+  {0xa8da, 0xa8df},
+  {0xa8fe, 0xa8ff},
+  {0xa954, 0xa95e},
+  {0xa97d, 0xa97f},
+  {0xa9ce, 0xa9ce},
+  {0xa9da, 0xa9dd},
+  {0xa9ff, 0xa9ff},
+  {0xaa37, 0xaa3f},
+  {0xaa4e, 0xaa4f},
+  {0xaa5a, 0xaa5b},
+  {0xaac3, 0xaada},
+  {0xaaf7, 0xab00},
+  {0xab07, 0xab08},
+  {0xab0f, 0xab10},
+  {0xab17, 0xab1f},
+  {0xab27, 0xab27},
+  {0xab2f, 0xab2f},
+  {0xab66, 0xab6f},
+  {0xabee, 0xabef},
+  {0xabfa, 0xabff},
+  {0xd7a4, 0xd7af},
+  {0xd7c7, 0xd7ca},
+  {0xd7fc, 0xd7ff},
+  {0xfa6e, 0xfa6f},
+  {0xfada, 0xfaff},
+  {0xfb07, 0xfb12},
+  {0xfb18, 0xfb1c},
+  {0xfb37, 0xfb37},
+  {0xfb3d, 0xfb3d},
+  {0xfb3f, 0xfb3f},
+  {0xfb42, 0xfb42},
+  {0xfb45, 0xfb45},
+  {0xfbc2, 0xfbd2},
+  {0xfd40, 0xfd4f},
+  {0xfd90, 0xfd91},
+  {0xfdc8, 0xfdef},
+  {0xfdfe, 0xfdff},
+  {0xfe1a, 0xfe1f},
+  {0xfe53, 0xfe53},
+  {0xfe67, 0xfe67},
+  {0xfe6c, 0xfe6f},
+  {0xfe75, 0xfe75},
+  {0xfefd, 0xfefe},
+  {0xff00, 0xff00},
+  {0xffbf, 0xffc1},
+  {0xffc8, 0xffc9},
+  {0xffd0, 0xffd1},
+  {0xffd8, 0xffd9},
+  {0xffdd, 0xffdf},
+  {0xffe7, 0xffe7},
+  {0xffef, 0xfff8},
+  {0xfffe, 0xffff},
+  {0x1000c, 0x1000c},
+  {0x10027, 0x10027},
+  {0x1003b, 0x1003b},
+  {0x1003e, 0x1003e},
+  {0x1004e, 0x1004f},
+  {0x1005e, 0x1007f},
+  {0x100fb, 0x100ff},
+  {0x10103, 0x10106},
+  {0x10134, 0x10136},
+  {0x1018f, 0x1018f},
+  {0x1019c, 0x1019f},
+  {0x101a1, 0x101cf},
+  {0x101fe, 0x1027f},
+  {0x1029d, 0x1029f},
+  {0x102d1, 0x102df},
+  {0x102fc, 0x102ff},
+  {0x10324, 0x1032f},
+  {0x1034b, 0x1034f},
+  {0x1037b, 0x1037f},
+  {0x1039e, 0x1039e},
+  {0x103c4, 0x103c7},
+  {0x103d6, 0x103ff},
+  {0x1049e, 0x1049f},
+  {0x104aa, 0x104af},
+  {0x104d4, 0x104d7},
+  {0x104fc, 0x104ff},
+  {0x10528, 0x1052f},
+  {0x10564, 0x1056e},
+  {0x10570, 0x105ff},
+  {0x10737, 0x1073f},
+  {0x10756, 0x1075f},
+  {0x10768, 0x107ff},
+  {0x10806, 0x10807},
+  {0x10809, 0x10809},
+  {0x10836, 0x10836},
+  {0x10839, 0x1083b},
+  {0x1083d, 0x1083e},
+  {0x10856, 0x10856},
+  {0x1089f, 0x108a6},
+  {0x108b0, 0x108df},
+  {0x108f3, 0x108f3},
+  {0x108f6, 0x108fa},
+  {0x1091c, 0x1091e},
+  {0x1093a, 0x1093e},
+  {0x10940, 0x1097f},
+  {0x109b8, 0x109bb},
+  {0x109d0, 0x109d1},
+  {0x10a04, 0x10a04},
+  {0x10a07, 0x10a0b},
+  {0x10a14, 0x10a14},
+  {0x10a18, 0x10a18},
+  {0x10a34, 0x10a37},
+  {0x10a3b, 0x10a3e},
+  {0x10a48, 0x10a4f},
+  {0x10a59, 0x10a5f},
+  {0x10aa0, 0x10abf},
+  {0x10ae7, 0x10aea},
+  {0x10af7, 0x10aff},
+  {0x10b36, 0x10b38},
+  {0x10b56, 0x10b57},
+  {0x10b73, 0x10b77},
+  {0x10b92, 0x10b98},
+  {0x10b9d, 0x10ba8},
+  {0x10bb0, 0x10bff},
+  {0x10c49, 0x10c7f},
+  {0x10cb3, 0x10cbf},
+  {0x10cf3, 0x10cf9},
+  {0x10d00, 0x10e5f},
+  {0x10e7f, 0x10fff},
+  {0x1104e, 0x11051},
+  {0x11070, 0x1107e},
+  {0x110c2, 0x110cf},
+  {0x110e9, 0x110ef},
+  {0x110fa, 0x110ff},
+  {0x11135, 0x11135},
+  {0x11144, 0x1114f},
+  {0x11177, 0x1117f},
+  {0x111ce, 0x111cf},
+  {0x111e0, 0x111e0},
+  {0x111f5, 0x111ff},
+  {0x11212, 0x11212},
+  {0x1123f, 0x1127f},
+  {0x11287, 0x11287},
+  {0x11289, 0x11289},
+  {0x1128e, 0x1128e},
+  {0x1129e, 0x1129e},
+  {0x112aa, 0x112af},
+  {0x112eb, 0x112ef},
+  {0x112fa, 0x112ff},
+  {0x11304, 0x11304},
+  {0x1130d, 0x1130e},
+  {0x11311, 0x11312},
+  {0x11329, 0x11329},
+  {0x11331, 0x11331},
+  {0x11334, 0x11334},
+  {0x1133a, 0x1133b},
+  {0x11345, 0x11346},
+  {0x11349, 0x1134a},
+  {0x1134e, 0x1134f},
+  {0x11351, 0x11356},
+  {0x11358, 0x1135c},
+  {0x11364, 0x11365},
+  {0x1136d, 0x1136f},
+  {0x11375, 0x113ff},
+  {0x1145a, 0x1145a},
+  {0x1145c, 0x1145c},
+  {0x1145e, 0x1147f},
+  {0x114c8, 0x114cf},
+  {0x114da, 0x1157f},
+  {0x115b6, 0x115b7},
+  {0x115de, 0x115ff},
+  {0x11645, 0x1164f},
+  {0x1165a, 0x1165f},
+  {0x1166d, 0x1167f},
+  {0x116b8, 0x116bf},
+  {0x116ca, 0x116ff},
+  {0x1171a, 0x1171c},
+  {0x1172c, 0x1172f},
+  {0x11740, 0x1189f},
+  {0x118f3, 0x118fe},
+  {0x11900, 0x11abf},
+  {0x11af9, 0x11bff},
+  {0x11c09, 0x11c09},
+  {0x11c37, 0x11c37},
+  {0x11c46, 0x11c4f},
+  {0x11c6d, 0x11c6f},
+  {0x11c90, 0x11c91},
+  {0x11ca8, 0x11ca8},
+  {0x11cb7, 0x11fff},
+  {0x1239a, 0x123ff},
+  {0x1246f, 0x1246f},
+  {0x12475, 0x1247f},
+  {0x12544, 0x12fff},
+  {0x1342f, 0x143ff},
+  {0x14647, 0x167ff},
+  {0x16a39, 0x16a3f},
+  {0x16a5f, 0x16a5f},
+  {0x16a6a, 0x16a6d},
+  {0x16a70, 0x16acf},
+  {0x16aee, 0x16aef},
+  {0x16af6, 0x16aff},
+  {0x16b46, 0x16b4f},
+  {0x16b5a, 0x16b5a},
+  {0x16b62, 0x16b62},
+  {0x16b78, 0x16b7c},
+  {0x16b90, 0x16eff},
+  {0x16f45, 0x16f4f},
+  {0x16f7f, 0x16f8e},
+  {0x16fa0, 0x16fdf},
+  {0x16fe1, 0x16fff},
+  {0x187ed, 0x187ff},
+  {0x18af3, 0x1afff},
+  {0x1b002, 0x1bbff},
+  {0x1bc6b, 0x1bc6f},
+  {0x1bc7d, 0x1bc7f},
+  {0x1bc89, 0x1bc8f},
+  {0x1bc9a, 0x1bc9b},
+  {0x1bca4, 0x1cfff},
+  {0x1d0f6, 0x1d0ff},
+  {0x1d127, 0x1d128},
+  {0x1d1e9, 0x1d1ff},
+  {0x1d246, 0x1d2ff},
+  {0x1d357, 0x1d35f},
+  {0x1d372, 0x1d3ff},
+  {0x1d455, 0x1d455},
+  {0x1d49d, 0x1d49d},
+  {0x1d4a0, 0x1d4a1},
+  {0x1d4a3, 0x1d4a4},
+  {0x1d4a7, 0x1d4a8},
+  {0x1d4ad, 0x1d4ad},
+  {0x1d4ba, 0x1d4ba},
+  {0x1d4bc, 0x1d4bc},
+  {0x1d4c4, 0x1d4c4},
+  {0x1d506, 0x1d506},
+  {0x1d50b, 0x1d50c},
+  {0x1d515, 0x1d515},
+  {0x1d51d, 0x1d51d},
+  {0x1d53a, 0x1d53a},
+  {0x1d53f, 0x1d53f},
+  {0x1d545, 0x1d545},
+  {0x1d547, 0x1d549},
+  {0x1d551, 0x1d551},
+  {0x1d6a6, 0x1d6a7},
+  {0x1d7cc, 0x1d7cd},
+  {0x1da8c, 0x1da9a},
+  {0x1daa0, 0x1daa0},
+  {0x1dab0, 0x1dfff},
+  {0x1e007, 0x1e007},
+  {0x1e019, 0x1e01a},
+  {0x1e022, 0x1e022},
+  {0x1e025, 0x1e025},
+  {0x1e02b, 0x1e7ff},
+  {0x1e8c5, 0x1e8c6},
+  {0x1e8d7, 0x1e8ff},
+  {0x1e94b, 0x1e94f},
+  {0x1e95a, 0x1e95d},
+  {0x1e960, 0x1edff},
+  {0x1ee04, 0x1ee04},
+  {0x1ee20, 0x1ee20},
+  {0x1ee23, 0x1ee23},
+  {0x1ee25, 0x1ee26},
+  {0x1ee28, 0x1ee28},
+  {0x1ee33, 0x1ee33},
+  {0x1ee38, 0x1ee38},
+  {0x1ee3a, 0x1ee3a},
+  {0x1ee3c, 0x1ee41},
+  {0x1ee43, 0x1ee46},
+  {0x1ee48, 0x1ee48},
+  {0x1ee4a, 0x1ee4a},
+  {0x1ee4c, 0x1ee4c},
+  {0x1ee50, 0x1ee50},
+  {0x1ee53, 0x1ee53},
+  {0x1ee55, 0x1ee56},
+  {0x1ee58, 0x1ee58},
+  {0x1ee5a, 0x1ee5a},
+  {0x1ee5c, 0x1ee5c},
+  {0x1ee5e, 0x1ee5e},
+  {0x1ee60, 0x1ee60},
+  {0x1ee63, 0x1ee63},
+  {0x1ee65, 0x1ee66},
+  {0x1ee6b, 0x1ee6b},
+  {0x1ee73, 0x1ee73},
+  {0x1ee78, 0x1ee78},
+  {0x1ee7d, 0x1ee7d},
+  {0x1ee7f, 0x1ee7f},
+  {0x1ee8a, 0x1ee8a},
+  {0x1ee9c, 0x1eea0},
+  {0x1eea4, 0x1eea4},
+  {0x1eeaa, 0x1eeaa},
+  {0x1eebc, 0x1eeef},
+  {0x1eef2, 0x1efff},
+  {0x1f02c, 0x1f02f},
+  {0x1f094, 0x1f09f},
+  {0x1f0af, 0x1f0b0},
+  {0x1f0c0, 0x1f0c0},
+  {0x1f0d0, 0x1f0d0},
+  {0x1f0f6, 0x1f0ff},
+  {0x1f10d, 0x1f10f},
+  {0x1f12f, 0x1f12f},
+  {0x1f16c, 0x1f16f},
+  {0x1f1ad, 0x1f1e5},
+  {0x1f203, 0x1f20f},
+  {0x1f23c, 0x1f23f},
+  {0x1f249, 0x1f24f},
+  {0x1f252, 0x1f2ff},
+  {0x1f6d3, 0x1f6df},
+  {0x1f6ed, 0x1f6ef},
+  {0x1f6f7, 0x1f6ff},
+  {0x1f774, 0x1f77f},
+  {0x1f7d5, 0x1f7ff},
+  {0x1f80c, 0x1f80f},
+  {0x1f848, 0x1f84f},
+  {0x1f85a, 0x1f85f},
+  {0x1f888, 0x1f88f},
+  {0x1f8ae, 0x1f90f},
+  {0x1f91f, 0x1f91f},
+  {0x1f928, 0x1f92f},
+  {0x1f931, 0x1f932},
+  {0x1f93f, 0x1f93f},
+  {0x1f94c, 0x1f94f},
+  {0x1f95f, 0x1f97f},
+  {0x1f992, 0x1f9bf},
+  {0x1f9c1, 0x1ffff},
+  {0x2a6d7, 0x2a6ff},
+  {0x2b735, 0x2b73f},
+  {0x2b81e, 0x2b81f},
+  {0x2cea2, 0x2f7ff},
+  {0x2fa1e, 0xe0000},
+  {0xe0002, 0xe001f},
+  {0xe0080, 0xe00ff},
+  {0xe01f0, 0xeffff},
+  {0xffffe, 0xfffff},
+};
+
+#define WCWIDTH9_ARRAY_SIZE(arr) ((sizeof(arr)/sizeof((arr)[0])) / ((size_t)(!(sizeof(arr) % sizeof((arr)[0])))))
+
+static inline bool wcwidth9_intable(const struct wcwidth9_interval *table, size_t n_items, int c) {
+  int mid, bot, top;
+
+  if (c < table[0].first) {
+    return false;
+  }
+
+  bot = 0;
+  top = (int)(n_items - 1);
+  while (top >= bot) {
+    mid = (bot + top) / 2;
+
+    if (table[mid].last < c) {
+      bot = mid + 1;
+    } else if (table[mid].first > c) {
+      top = mid - 1;
+    } else {
+      return true;
+    }
+  }
+
+  return false;
+}
+
+static inline int wcwidth9(int c) {
+  if (c < 0 || c > 0x10ffff) {
+    return -1;
+  }
+
+  if (wcwidth9_intable(wcwidth9_nonprint, WCWIDTH9_ARRAY_SIZE(wcwidth9_nonprint), c)) {
+    return -1;
+  }
+
+  if (wcwidth9_intable(wcwidth9_combining, WCWIDTH9_ARRAY_SIZE(wcwidth9_combining), c)) {
+    return -1;
+  }
+
+  if (wcwidth9_intable(wcwidth9_not_assigned, WCWIDTH9_ARRAY_SIZE(wcwidth9_not_assigned), c)) {
+    return -1;
+  }
+
+  if (wcwidth9_intable(wcwidth9_private, WCWIDTH9_ARRAY_SIZE(wcwidth9_private), c)) {
+    return -3;
+  }
+
+  if (wcwidth9_intable(wcwidth9_ambiguous, WCWIDTH9_ARRAY_SIZE(wcwidth9_ambiguous), c)) {
+    return -2;
+  }
+
+  if (wcwidth9_intable(wcwidth9_doublewidth, WCWIDTH9_ARRAY_SIZE(wcwidth9_doublewidth), c)) {
+    return 2;
+  }
+
+  if (wcwidth9_intable(wcwidth9_emoji_width, WCWIDTH9_ARRAY_SIZE(wcwidth9_emoji_width), c)) {
+    return 2;
+  }
+
+  return 1;
+}
+
+#endif /* WCWIDTH9_H */
diff --git a/tests/apply-legacy-with-contexted-hunks.sh b/tests/apply-legacy-with-contexted-hunks.sh
new file mode 100644
index 00000000..45d37c54
--- /dev/null
+++ b/tests/apply-legacy-with-contexted-hunks.sh
@@ -0,0 +1,42 @@
+#!/usr/bin/env bash
+
+. lib
+
+case $format in
+  darcs-1)
+    v=v1
+    ;;
+  darcs-2)
+    v=v2
+    ;;
+  darcs-3)
+    exit # no legacy formats!
+    ;;
+esac
+
+rm -rf empty
+mkdir empty
+cd empty
+darcs init
+cd ..
+
+unpack_testdata context-$v
+
+rm -rf R
+darcs clone empty R
+cd R
+darcs apply $TESTDATA/legacy/context-$v.dpatch
+darcs pull ../repo | grep 'No remote patches to pull'
+darcs push ../repo | grep 'No recorded local patches to push'
+cd ..
+
+if test "$v" = "v2"; then
+  repos="resolution simple threewayanddep threewayandmultideps threewayconflict tworesolutions twowayconflict"
+  for r in $repos ; do
+    rm -rf R
+    darcs clone empty R
+    cd R
+    darcs apply --allow-conflicts $TESTDATA/legacy/darcs2/$r.dpatch >&2
+    cd ..
+  done
+fi
diff --git a/tests/conflict-fight.sh b/tests/conflict-fight.sh
old mode 100644
new mode 100755
diff --git a/tests/data/context-v1.dpatch b/tests/data/context-v1.dpatch
index 02ffb599..5f268f23 100644
--- a/tests/data/context-v1.dpatch
+++ b/tests/data/context-v1.dpatch
@@ -29,22 +29,17 @@ hunk ./wibble 1
 +9
 +10
 }
+
 [ABC
 Ganesh Sittampalam <ganesh@earth.li>**20101021172831
  Ignore-this: 157403967fc6753e0f2540535937da5b
 ] hunk ./wibble 4
- 1
- 2
- 3
 -4
 -5
 -6
 +4A
 +5B
 +6C
- 7
- 8
- 9
 
 Context:
 
diff --git a/tests/data/context-v2.dpatch b/tests/data/context-v2.dpatch
index 6b95625f..9066423b 100644
--- a/tests/data/context-v2.dpatch
+++ b/tests/data/context-v2.dpatch
@@ -27,22 +27,17 @@ hunk ./wibble 1
 +8
 +9
 +10
+
 [ABC
 Ganesh Sittampalam <ganesh@earth.li>**20101021172831
  Ignore-this: 157403967fc6753e0f2540535937da5b
 ] hunk ./wibble 4
- 1
- 2
- 3
 -4
 -5
 -6
 +4A
 +5B
 +6C
- 7
- 8
- 9
 
 Context:
 
diff --git a/tests/data/context-v3.dpatch b/tests/data/context-v3.dpatch
new file mode 100644
index 00000000..272dcd9f
--- /dev/null
+++ b/tests/data/context-v3.dpatch
@@ -0,0 +1,48 @@
+2 patches for repository /home/ben/src/darcs/head/xxx/Darcs3/Patience/WithIndex/WithCache/send-output/empty:
+
+patch f61189e3150c02fe42de53a42f12ecf624870ef0
+Author: Ben Franksen <ben.franksen@online.de>
+Date:   Sat Jul 16 09:07:22 CEST 2022
+  * init
+
+patch 116b881c438ec6f3b69f9a152c407afadec2c55b
+Author: Ben Franksen <ben.franksen@online.de>
+Date:   Sat Jul 16 09:08:03 CEST 2022
+  * ABC
+
+New patches:
+
+[init
+Ben Franksen <ben.franksen@online.de>**20220716070722
+ Ignore-this: 99d3a42017d02a59c10a5f84bcd269a95fd0241a3a2986a660162d4db4905f94774f91a691d5f6fa
+] hash 1 f61189e3150c02fe42de53a42f12ecf624870ef0
+addfile ./wibble
+hash 2 f61189e3150c02fe42de53a42f12ecf624870ef0
+hunk ./wibble 1
++1
++2
++3
++4
++5
++6
++7
++8
++9
++10
+
+[ABC
+Ben Franksen <ben.franksen@online.de>**20220716070803
+ Ignore-this: 5235c7a2a9ee35f2c7908dab0fe5f53a5ef22c21348c89f1a5949be034ee76c6a76bc3ca59cb1b4d
+] hash 1 116b881c438ec6f3b69f9a152c407afadec2c55b
+hunk ./wibble 4
+-4
+-5
+-6
++4A
++5B
++6C
+
+Context:
+
+Patch bundle hash:
+d5c78653b80a55ee82a30f74864381c1f2275d99
diff --git a/tests/data/context-v3.tgz b/tests/data/context-v3.tgz
new file mode 100644
index 00000000..f7374d36
Binary files /dev/null and b/tests/data/context-v3.tgz differ
diff --git a/tests/data/convert/darcs2/resolution.dpatch b/tests/data/convert/darcs2/resolution.dpatch
index b64fd7f1..a44c1bd9 100644
--- a/tests/data/convert/darcs2/resolution.dpatch
+++ b/tests/data/convert/darcs2/resolution.dpatch
@@ -33,12 +33,13 @@ tester**20101016223207
 ] addfile ./wibble
 hunk ./wibble 1
 +wibble
+
 [A
 tester**20101016223207
  Ignore-this: bc0d30ac5170e1a25ccb20e6cb06ac86
 ] hunk ./wibble 2
- wibble
 +A
+
 [B
 tester**20101016223207
  Ignore-this: 3bbebcf8fa444bdcb31ab799c6754067
@@ -49,12 +50,13 @@ hunk ./wibble 2
 :
 hunk ./wibble 2
 +B
+
 [AB
 tester**20101016223207
  Ignore-this: 8fa03d26b9dbbcdb50a323e5c58b16dd
 ] hunk ./wibble 2
- wibble
 +AB
+
 [C
 tester**20101016223207
  Ignore-this: e7c0716361e411645066f8a3c2eff769
diff --git a/tests/data/convert/darcs2/threewayanddep.dpatch b/tests/data/convert/darcs2/threewayanddep.dpatch
index 2c754f4f..6c29b4ba 100644
--- a/tests/data/convert/darcs2/threewayanddep.dpatch
+++ b/tests/data/convert/darcs2/threewayanddep.dpatch
@@ -33,19 +33,19 @@ tester**20101016222754
 ] addfile ./wibble
 hunk ./wibble 1
 +wibble
+
 [A1
 tester**20101016222754
  Ignore-this: 54df34ebd488b772c37c3d43a38b0bfa
 ] hunk ./wibble 2
- wibble
 +A1
+
 [A2
 tester**20101016222754
  Ignore-this: 4d1b08c7274743e7d0d2f210518d5a19
 ] hunk ./wibble 3
- wibble
- A1
 +A2
+
 [B
 tester**20101016222754
  Ignore-this: 9ba51da6bb1506afa2104326cd5df54b
@@ -58,6 +58,7 @@ hunk ./wibble 3
 :
 hunk ./wibble 2
 +B
+
 [C
 tester**20101016222754
  Ignore-this: 295e8a851b7a936b3d08b0ce7eaaf2ac
diff --git a/tests/data/convert/darcs2/threewayandmultideps.dpatch b/tests/data/convert/darcs2/threewayandmultideps.dpatch
index e1735d6c..ea191142 100644
--- a/tests/data/convert/darcs2/threewayandmultideps.dpatch
+++ b/tests/data/convert/darcs2/threewayandmultideps.dpatch
@@ -43,19 +43,19 @@ tester**20101016222721
 ] addfile ./wibble
 hunk ./wibble 1
 +wibble
+
 [A1
 tester**20101016222721
  Ignore-this: d749f48333e6ff2e994b1df71e76933b
 ] hunk ./wibble 2
- wibble
 +A1
+
 [A2
 tester**20101016222721
  Ignore-this: 6f006a52975a708a8038d52e5e39ef0f
 ] hunk ./wibble 3
- wibble
- A1
 +A2
+
 [B1
 tester**20101016222721
  Ignore-this: f4d4b5b1c73bd6fa8abe6e5e680d66a7
@@ -68,6 +68,7 @@ hunk ./wibble 3
 :
 hunk ./wibble 2
 +B1
+
 [B2
 tester**20101016222721
  Ignore-this: 1d60b6c0ba913fff4d1e32ad26ae07bb
@@ -89,6 +90,7 @@ hunk ./wibble 2
 :
 hunk ./wibble 3
 +B2
+
 [C1
 tester**20101016222721
  Ignore-this: 25b6a6959d19980ad16983a542c6825
@@ -113,6 +115,7 @@ hunk ./wibble 3
 :
 hunk ./wibble 2
 +C1
+
 [C2
 tester**20101016222721
  Ignore-this: c16d607216c36d5f7727c64d2ec103d4
diff --git a/tests/data/convert/darcs2/threewayconflict.dpatch b/tests/data/convert/darcs2/threewayconflict.dpatch
index aaa0749c..df5a8913 100644
--- a/tests/data/convert/darcs2/threewayconflict.dpatch
+++ b/tests/data/convert/darcs2/threewayconflict.dpatch
@@ -28,12 +28,13 @@ tester**20101016222814
 ] addfile ./wibble
 hunk ./wibble 1
 +wibble
+
 [A
 tester**20101016222814
  Ignore-this: 653be63c1f8a6f4bc1de1e45c0ae9084
 ] hunk ./wibble 2
- wibble
 +A
+
 [B
 tester**20101016222814
  Ignore-this: 1a8e3f57d2baeca09f2dda003e4df58d
@@ -44,6 +45,7 @@ hunk ./wibble 2
 :
 hunk ./wibble 2
 +B
+
 [C
 tester**20101016222814
  Ignore-this: 9d40b33ef1b73b9a950f39c4e8a75dfe
diff --git a/tests/data/convert/darcs2/tworesolutions.dpatch b/tests/data/convert/darcs2/tworesolutions.dpatch
index f46a2905..59a99e1b 100644
--- a/tests/data/convert/darcs2/tworesolutions.dpatch
+++ b/tests/data/convert/darcs2/tworesolutions.dpatch
@@ -43,12 +43,13 @@ tester**20101016223433
 ] addfile ./wibble
 hunk ./wibble 1
 +wibble
+
 [A
 tester**20101016223433
  Ignore-this: 580c4417986d5c56590bf36f5a125f38
 ] hunk ./wibble 2
- wibble
 +A
+
 [B
 tester**20101016223433
  Ignore-this: a9f2335fe2dc972fd0bc09edc6252256
@@ -59,12 +60,13 @@ hunk ./wibble 2
 :
 hunk ./wibble 2
 +B
+
 [AB
 tester**20101016223433
  Ignore-this: cba095e78e2bdfe15dbdf2cb5c69cc6d
 ] hunk ./wibble 2
- wibble
 +AB
+
 [C
 tester**20101016223433
  Ignore-this: da2a7e05abed8dba0077e69e55bd926
@@ -75,12 +77,13 @@ hunk ./wibble 2
 :
 hunk ./wibble 2
 +C
+
 [ABC
 tester**20101016223433
  Ignore-this: db94de3935df87d0a991c0ab6a58e5b1
 ] hunk ./wibble 2
- wibble
 +ABC
+
 [D
 tester**20101016223433
  Ignore-this: 829adb4326b290aa6f741b3a15fbabfc
diff --git a/tests/data/convert/darcs2/twowayconflict.dpatch b/tests/data/convert/darcs2/twowayconflict.dpatch
index a2dab63e..e94d056a 100644
--- a/tests/data/convert/darcs2/twowayconflict.dpatch
+++ b/tests/data/convert/darcs2/twowayconflict.dpatch
@@ -23,12 +23,13 @@ tester**20101016222822
 ] addfile ./wibble
 hunk ./wibble 1
 +wibble
+
 [A
 tester**20101016222822
  Ignore-this: 2d69de402438481946682efcad5e20cd
 ] hunk ./wibble 2
- wibble
 +A
+
 [B
 tester**20101016222822
  Ignore-this: 9c8daaedcb674c022ddbcef19752d694
diff --git a/tests/data/legacy/context-v1.dpatch b/tests/data/legacy/context-v1.dpatch
new file mode 100644
index 00000000..02ffb599
--- /dev/null
+++ b/tests/data/legacy/context-v1.dpatch
@@ -0,0 +1,52 @@
+2 patches for repository /home/ganesh/darcs-comp/temp/empty:
+
+patch 573defe88544e8f75a18e530e3aeaf6608951aa1
+Author: Ganesh Sittampalam <ganesh@earth.li>
+Date:   Thu Oct 21 18:28:18 BST 2010
+  * init
+
+patch c8ec7c8b2df55720ba2c3a21adb80790363f421e
+Author: Ganesh Sittampalam <ganesh@earth.li>
+Date:   Thu Oct 21 18:28:31 BST 2010
+  * ABC
+
+New patches:
+
+[init
+Ganesh Sittampalam <ganesh@earth.li>**20101021172818
+ Ignore-this: 6a770d5966ed23f56e94c08977507388
+] {
+addfile ./wibble
+hunk ./wibble 1
++1
++2
++3
++4
++5
++6
++7
++8
++9
++10
+}
+[ABC
+Ganesh Sittampalam <ganesh@earth.li>**20101021172831
+ Ignore-this: 157403967fc6753e0f2540535937da5b
+] hunk ./wibble 4
+ 1
+ 2
+ 3
+-4
+-5
+-6
++4A
++5B
++6C
+ 7
+ 8
+ 9
+
+Context:
+
+Patch bundle hash:
+0a20411489222e188722666cf0db4c5de2539aee
diff --git a/tests/data/legacy/context-v2.dpatch b/tests/data/legacy/context-v2.dpatch
new file mode 100644
index 00000000..6b95625f
--- /dev/null
+++ b/tests/data/legacy/context-v2.dpatch
@@ -0,0 +1,50 @@
+2 patches for repository /home/ganesh/darcs-comp/temp/empty:
+
+patch 573defe88544e8f75a18e530e3aeaf6608951aa1
+Author: Ganesh Sittampalam <ganesh@earth.li>
+Date:   Thu Oct 21 18:28:18 BST 2010
+  * init
+
+patch c8ec7c8b2df55720ba2c3a21adb80790363f421e
+Author: Ganesh Sittampalam <ganesh@earth.li>
+Date:   Thu Oct 21 18:28:31 BST 2010
+  * ABC
+
+New patches:
+
+[init
+Ganesh Sittampalam <ganesh@earth.li>**20101021172818
+ Ignore-this: 6a770d5966ed23f56e94c08977507388
+] addfile ./wibble
+hunk ./wibble 1
++1
++2
++3
++4
++5
++6
++7
++8
++9
++10
+[ABC
+Ganesh Sittampalam <ganesh@earth.li>**20101021172831
+ Ignore-this: 157403967fc6753e0f2540535937da5b
+] hunk ./wibble 4
+ 1
+ 2
+ 3
+-4
+-5
+-6
++4A
++5B
++6C
+ 7
+ 8
+ 9
+
+Context:
+
+Patch bundle hash:
+846f06469d8639ad0762c33e2030e5c24ebb1832
diff --git a/tests/data/legacy/darcs2/resolution.dpatch b/tests/data/legacy/darcs2/resolution.dpatch
new file mode 100644
index 00000000..b64fd7f1
--- /dev/null
+++ b/tests/data/legacy/darcs2/resolution.dpatch
@@ -0,0 +1,72 @@
+5 patches for repository /tmp/tmp6648/temp/empty-darcs2:
+
+patch c88a093ab344f21fc3af74eee6741db45df22498
+Author: tester
+Date:   Sat Oct 16 23:32:07 BST 2010
+  * wibble
+
+patch 9d61f1de5ae27b8f1678735b4741abe4a869d899
+Author: tester
+Date:   Sat Oct 16 23:32:07 BST 2010
+  * A
+
+patch 3b3282935c87c2aede246a42f5c0a926fae2be35
+Author: tester
+Date:   Sat Oct 16 23:32:07 BST 2010
+  * B
+
+patch bc42df597aa06b720f03367499e3dffe36baa9a4
+Author: tester
+Date:   Sat Oct 16 23:32:07 BST 2010
+  * AB
+
+patch 8efe5b608a6236bd136ead946ef26369207ca5ac
+Author: tester
+Date:   Sat Oct 16 23:32:07 BST 2010
+  * C
+
+New patches:
+
+[wibble
+tester**20101016223207
+ Ignore-this: 64b5a1e603ddf61e59421bdde45b3bc
+] addfile ./wibble
+hunk ./wibble 1
++wibble
+[A
+tester**20101016223207
+ Ignore-this: bc0d30ac5170e1a25ccb20e6cb06ac86
+] hunk ./wibble 2
+ wibble
++A
+[B
+tester**20101016223207
+ Ignore-this: 3bbebcf8fa444bdcb31ab799c6754067
+] conflictor [
+hunk ./wibble 2
++A
+]
+:
+hunk ./wibble 2
++B
+[AB
+tester**20101016223207
+ Ignore-this: 8fa03d26b9dbbcdb50a323e5c58b16dd
+] hunk ./wibble 2
+ wibble
++AB
+[C
+tester**20101016223207
+ Ignore-this: e7c0716361e411645066f8a3c2eff769
+] conflictor [
+hunk ./wibble 2
++AB
+]
+:
+hunk ./wibble 2
++C
+
+Context:
+
+Patch bundle hash:
+cc43b921f6010f451b2dbe275b7fcd04c3862335
diff --git a/tests/data/legacy/darcs2/simple.dpatch b/tests/data/legacy/darcs2/simple.dpatch
new file mode 100644
index 00000000..bca0abbd
--- /dev/null
+++ b/tests/data/legacy/darcs2/simple.dpatch
@@ -0,0 +1,20 @@
+1 patch for repository /tmp/tmp5746/temp/empty-darcs2:
+
+patch 62068c47f23550e3a32aaf652d1e14e53598ba98
+Author: tester
+Date:   Sat Oct 16 23:28:30 BST 2010
+  * wibble
+
+New patches:
+
+[wibble
+tester**20101016222830
+ Ignore-this: f155bc27211e0233c23b8c0a757b8071
+] addfile ./wibble
+hunk ./wibble 1
++wibble
+
+Context:
+
+Patch bundle hash:
+75ced55c52362a8b2ff171b48751d19000fe1790
diff --git a/tests/data/legacy/darcs2/threewayanddep.dpatch b/tests/data/legacy/darcs2/threewayanddep.dpatch
new file mode 100644
index 00000000..2c754f4f
--- /dev/null
+++ b/tests/data/legacy/darcs2/threewayanddep.dpatch
@@ -0,0 +1,84 @@
+5 patches for repository /tmp/convert-darcs2/Darcs2/PatienceDiff/convert-darcs2/no-working-dir/threewayanddep/empty-darcs2:
+
+patch 349a0bab437265867f9af955d72127bac4cea1a6
+Author: tester
+Date:   Sun Oct 17 00:27:54 CEST 2010
+  * wibble
+
+patch 650955997f5fac7fa2e14127a25ea5ac70f4dab0
+Author: tester
+Date:   Sun Oct 17 00:27:54 CEST 2010
+  * A1
+
+patch 476d8520cfc9be9b44299e6f4753de6adca83bcf
+Author: tester
+Date:   Sun Oct 17 00:27:54 CEST 2010
+  * A2
+
+patch 4d2a18f739f8f4c384b5653a5ad03d5e77724efe
+Author: tester
+Date:   Sun Oct 17 00:27:54 CEST 2010
+  * B
+
+patch 81ba98134cf0d725e827318ca2753be4148568b7
+Author: tester
+Date:   Sun Oct 17 00:27:54 CEST 2010
+  * C
+
+New patches:
+
+[wibble
+tester**20101016222754
+ Ignore-this: 355914edd0f88f0ea7c2ef60aec9c2a1
+] addfile ./wibble
+hunk ./wibble 1
++wibble
+[A1
+tester**20101016222754
+ Ignore-this: 54df34ebd488b772c37c3d43a38b0bfa
+] hunk ./wibble 2
+ wibble
++A1
+[A2
+tester**20101016222754
+ Ignore-this: 4d1b08c7274743e7d0d2f210518d5a19
+] hunk ./wibble 3
+ wibble
+ A1
++A2
+[B
+tester**20101016222754
+ Ignore-this: 9ba51da6bb1506afa2104326cd5df54b
+] conflictor [
+hunk ./wibble 2
++A1
+hunk ./wibble 3
++A2
+]
+:
+hunk ./wibble 2
++B
+[C
+tester**20101016222754
+ Ignore-this: 295e8a851b7a936b3d08b0ce7eaaf2ac
+] conflictor {{
+hunk ./wibble 2
++A1
+:
+hunk ./wibble 3
++A2
+:
+hunk ./wibble 2
++A1
+:
+hunk ./wibble 2
++B
+}} []
+:
+hunk ./wibble 2
++C
+
+Context:
+
+Patch bundle hash:
+5d566c305f4017424a6b05e87bfc5971e95e877d
diff --git a/tests/data/legacy/darcs2/threewayandmultideps.dpatch b/tests/data/legacy/darcs2/threewayandmultideps.dpatch
new file mode 100644
index 00000000..e1735d6c
--- /dev/null
+++ b/tests/data/legacy/darcs2/threewayandmultideps.dpatch
@@ -0,0 +1,149 @@
+7 patches for repository /tmp/convert-darcs2/Darcs2/PatienceDiff/convert-darcs2/no-working-dir/threewayandmultideps/empty-darcs2:
+
+patch fd370912c8a92d249e00e7c91856ed9530d6c914
+Author: tester
+Date:   Sun Oct 17 00:27:21 CEST 2010
+  * wibble
+
+patch ac7df6a4761de10b4c440a9adb39c4f0236cb519
+Author: tester
+Date:   Sun Oct 17 00:27:21 CEST 2010
+  * A1
+
+patch 121d6130551316a64fa7a061cfc44f5946213f85
+Author: tester
+Date:   Sun Oct 17 00:27:21 CEST 2010
+  * A2
+
+patch 513848985dfc5b5ea1533d56b597daa7317f35bc
+Author: tester
+Date:   Sun Oct 17 00:27:21 CEST 2010
+  * B1
+
+patch 84edd5450901a4d31f1b49a9a6da4563a6ed73fe
+Author: tester
+Date:   Sun Oct 17 00:27:21 CEST 2010
+  * B2
+
+patch bec254c63929d83d13929eec63f2e5e5a8aabbb4
+Author: tester
+Date:   Sun Oct 17 00:27:21 CEST 2010
+  * C1
+
+patch 0e08cbe9489dfc7f21e9528b4c6a7d06f4fec25a
+Author: tester
+Date:   Sun Oct 17 00:27:21 CEST 2010
+  * C2
+
+New patches:
+
+[wibble
+tester**20101016222721
+ Ignore-this: 64432ba123d81c8f0e688b44feb8f587
+] addfile ./wibble
+hunk ./wibble 1
++wibble
+[A1
+tester**20101016222721
+ Ignore-this: d749f48333e6ff2e994b1df71e76933b
+] hunk ./wibble 2
+ wibble
++A1
+[A2
+tester**20101016222721
+ Ignore-this: 6f006a52975a708a8038d52e5e39ef0f
+] hunk ./wibble 3
+ wibble
+ A1
++A2
+[B1
+tester**20101016222721
+ Ignore-this: f4d4b5b1c73bd6fa8abe6e5e680d66a7
+] conflictor [
+hunk ./wibble 2
++A1
+hunk ./wibble 3
++A2
+]
+:
+hunk ./wibble 2
++B1
+[B2
+tester**20101016222721
+ Ignore-this: 1d60b6c0ba913fff4d1e32ad26ae07bb
+] conflictor {{
+hunk ./wibble 2
++A1
+:
+hunk ./wibble 3
++A2
+:
+hunk ./wibble 2
++A1
+:
+hunk ./wibble 2
++B1
+}} []
+hunk ./wibble 2
++B1
+:
+hunk ./wibble 3
++B2
+[C1
+tester**20101016222721
+ Ignore-this: 25b6a6959d19980ad16983a542c6825
+] conflictor {{
+hunk ./wibble 2
++A1
+:
+hunk ./wibble 3
++A2
+:
+hunk ./wibble 2
++A1
+:
+hunk ./wibble 2
++B1
+hunk ./wibble 2
++B1
+:
+hunk ./wibble 3
++B2
+}} []
+:
+hunk ./wibble 2
++C1
+[C2
+tester**20101016222721
+ Ignore-this: c16d607216c36d5f7727c64d2ec103d4
+] conflictor {{
+hunk ./wibble 2
++A1
+:
+hunk ./wibble 3
++A2
+:
+hunk ./wibble 2
++A1
+hunk ./wibble 2
++B1
+:
+hunk ./wibble 3
++B2
+:
+hunk ./wibble 2
++B1
+:
+hunk ./wibble 2
++C1
+}} []
+hunk ./wibble 2
++C1
+:
+hunk ./wibble 3
++C2
+
+Context:
+
+Patch bundle hash:
+8eb9adf3347935c847172e49b6597d14239d217f
diff --git a/tests/data/legacy/darcs2/threewayconflict.dpatch b/tests/data/legacy/darcs2/threewayconflict.dpatch
new file mode 100644
index 00000000..aaa0749c
--- /dev/null
+++ b/tests/data/legacy/darcs2/threewayconflict.dpatch
@@ -0,0 +1,65 @@
+4 patches for repository /tmp/tmp5605/temp/empty-darcs2:
+
+patch 8d6bfafe7ac2a628340563d92917da9639a8d509
+Author: tester
+Date:   Sat Oct 16 23:28:14 BST 2010
+  * wibble
+
+patch c0a55ca9dedb993d05d2779ca4f72984e87083cd
+Author: tester
+Date:   Sat Oct 16 23:28:14 BST 2010
+  * A
+
+patch fb027d809948379ca6357d654a6ce8cf45235dfa
+Author: tester
+Date:   Sat Oct 16 23:28:14 BST 2010
+  * B
+
+patch 7eeb8289feadd843a19485f493235566a2c48bea
+Author: tester
+Date:   Sat Oct 16 23:28:14 BST 2010
+  * C
+
+New patches:
+
+[wibble
+tester**20101016222814
+ Ignore-this: c125275c671c210086eccb12de9f6c1c
+] addfile ./wibble
+hunk ./wibble 1
++wibble
+[A
+tester**20101016222814
+ Ignore-this: 653be63c1f8a6f4bc1de1e45c0ae9084
+] hunk ./wibble 2
+ wibble
++A
+[B
+tester**20101016222814
+ Ignore-this: 1a8e3f57d2baeca09f2dda003e4df58d
+] conflictor [
+hunk ./wibble 2
++A
+]
+:
+hunk ./wibble 2
++B
+[C
+tester**20101016222814
+ Ignore-this: 9d40b33ef1b73b9a950f39c4e8a75dfe
+] conflictor {{
+:
+hunk ./wibble 2
++A
+:
+hunk ./wibble 2
++B
+}} []
+:
+hunk ./wibble 2
++C
+
+Context:
+
+Patch bundle hash:
+ba3e1ce15840fd37358fcd43c4c03273d1779153
diff --git a/tests/data/legacy/darcs2/tworesolutions.dpatch b/tests/data/legacy/darcs2/tworesolutions.dpatch
new file mode 100644
index 00000000..f46a2905
--- /dev/null
+++ b/tests/data/legacy/darcs2/tworesolutions.dpatch
@@ -0,0 +1,98 @@
+7 patches for repository /tmp/tmp6805/temp/empty-darcs2:
+
+patch d1638af339ea13cf23df131015309be1915ae247
+Author: tester
+Date:   Sat Oct 16 23:34:33 BST 2010
+  * wibble
+
+patch 687f568b2fa78eea4431b49c76524fd75cce06bf
+Author: tester
+Date:   Sat Oct 16 23:34:33 BST 2010
+  * A
+
+patch f1859e4ecd30f209ad08440964b3fa7b7bb8318d
+Author: tester
+Date:   Sat Oct 16 23:34:33 BST 2010
+  * B
+
+patch bb4b77fc72cf19af130db16c173f73341d847271
+Author: tester
+Date:   Sat Oct 16 23:34:33 BST 2010
+  * AB
+
+patch fe0a5a17610dbffc90b421d3b40a9ee30ff7e484
+Author: tester
+Date:   Sat Oct 16 23:34:33 BST 2010
+  * C
+
+patch 4ecd0a21ee5b7150e567a83c150810656ad76006
+Author: tester
+Date:   Sat Oct 16 23:34:33 BST 2010
+  * ABC
+
+patch 756f4b3ac209102b5804ad71e54852b74a7281c1
+Author: tester
+Date:   Sat Oct 16 23:34:33 BST 2010
+  * D
+
+New patches:
+
+[wibble
+tester**20101016223433
+ Ignore-this: 577185c51e4839dd1041372fbfa8515b
+] addfile ./wibble
+hunk ./wibble 1
++wibble
+[A
+tester**20101016223433
+ Ignore-this: 580c4417986d5c56590bf36f5a125f38
+] hunk ./wibble 2
+ wibble
++A
+[B
+tester**20101016223433
+ Ignore-this: a9f2335fe2dc972fd0bc09edc6252256
+] conflictor [
+hunk ./wibble 2
++A
+]
+:
+hunk ./wibble 2
++B
+[AB
+tester**20101016223433
+ Ignore-this: cba095e78e2bdfe15dbdf2cb5c69cc6d
+] hunk ./wibble 2
+ wibble
++AB
+[C
+tester**20101016223433
+ Ignore-this: da2a7e05abed8dba0077e69e55bd926
+] conflictor [
+hunk ./wibble 2
++AB
+]
+:
+hunk ./wibble 2
++C
+[ABC
+tester**20101016223433
+ Ignore-this: db94de3935df87d0a991c0ab6a58e5b1
+] hunk ./wibble 2
+ wibble
++ABC
+[D
+tester**20101016223433
+ Ignore-this: 829adb4326b290aa6f741b3a15fbabfc
+] conflictor [
+hunk ./wibble 2
++ABC
+]
+:
+hunk ./wibble 2
++D
+
+Context:
+
+Patch bundle hash:
+b0ac3265aeb09b15b7dbc1dcf9447dae35d00a86
diff --git a/tests/data/legacy/darcs2/twowayconflict.dpatch b/tests/data/legacy/darcs2/twowayconflict.dpatch
new file mode 100644
index 00000000..a2dab63e
--- /dev/null
+++ b/tests/data/legacy/darcs2/twowayconflict.dpatch
@@ -0,0 +1,46 @@
+3 patches for repository /tmp/tmp5677/temp/empty-darcs2:
+
+patch 8b8ee8c8e9bae5fe01abfd8c991071091241aa1f
+Date:   Sat Oct 16 23:28:22 BST 2010
+Author: tester
+  * wibble
+
+patch 23373e39b77dbce4de67f7631221f2d873ae21df
+Author: tester
+Date:   Sat Oct 16 23:28:22 BST 2010
+  * A
+
+patch 0058ef88cdd3606a9fbcfa00fb8b7d494db77481
+Author: tester
+Date:   Sat Oct 16 23:28:22 BST 2010
+  * B
+
+New patches:
+
+[wibble
+tester**20101016222822
+ Ignore-this: 88662d08dd524d92ad4cca6df0d643e4
+] addfile ./wibble
+hunk ./wibble 1
++wibble
+[A
+tester**20101016222822
+ Ignore-this: 2d69de402438481946682efcad5e20cd
+] hunk ./wibble 2
+ wibble
++A
+[B
+tester**20101016222822
+ Ignore-this: 9c8daaedcb674c022ddbcef19752d694
+] conflictor [
+hunk ./wibble 2
++A
+]
+:
+hunk ./wibble 2
++B
+
+Context:
+
+Patch bundle hash:
+33bebb546403626fc8539d4709fbcdb99e47e94c
diff --git a/tests/data/simple-v3.dpatch b/tests/data/simple-v3.dpatch
new file mode 100644
index 00000000..e72ba01c
--- /dev/null
+++ b/tests/data/simple-v3.dpatch
@@ -0,0 +1,22 @@
+1 patch for repository /home/ben/scratch/empty:
+
+patch c51abcc1d7270f96e2dc99663c97f556c0290cd4
+Author: Ben Franksen <ben.franksen@online.de>
+Date:   Sun Jul 17 21:30:37 CEST 2022
+  * wibble
+
+New patches:
+
+[wibble
+Ben Franksen <ben.franksen@online.de>**20220717193037
+ Ignore-this: e3a441a89d6cbcefb34ee7ee8dfe00d7bee0abcca8328168884552add2616772452ddc81780b27fa
+] hash 1 c51abcc1d7270f96e2dc99663c97f556c0290cd4
+addfile ./wibble
+hash 2 c51abcc1d7270f96e2dc99663c97f556c0290cd4
+hunk ./wibble 1
++wibble
+
+Context:
+
+Patch bundle hash:
+33e1905ec3be090b96aafd48da91e1e6021301a0
diff --git a/tests/data/simple-v3.tgz b/tests/data/simple-v3.tgz
new file mode 100644
index 00000000..2954be5c
Binary files /dev/null and b/tests/data/simple-v3.tgz differ
diff --git a/tests/failing-issue1241-rollback-with-file-beyond-tag.sh b/tests/failing-issue1241-rollback-with-file-beyond-tag.sh
old mode 100644
new mode 100755
diff --git a/tests/failing-issue2272-rebase-unsuspend-copes-with-unrecorded-changes.sh b/tests/failing-issue2272-rebase-unsuspend-copes-with-unrecorded-changes.sh
index 79dbadbd..032b2b13 100644
--- a/tests/failing-issue2272-rebase-unsuspend-copes-with-unrecorded-changes.sh
+++ b/tests/failing-issue2272-rebase-unsuspend-copes-with-unrecorded-changes.sh
@@ -41,9 +41,15 @@ darcs add 2.txt
 # Suspend the initial patch
 darcs rebase suspend -a -p 'adding original line'
 
+# save the repo so far
+rm -rf ../S
+cp -r . ../S
+
 # Now, unsuspend that patch. It should succeed despite unrecorded changes being present.
 darcs rebase unsuspend -a
 
+cd ../S
+
 # Additional case: An unrecorded change that conflicts with the suspended patch
 # This should succeed, but leave conflict markers.
 echo 'modified line' >t.txt
diff --git a/tests/issue1987.sh b/tests/issue1987.sh
index 88be62e8..8eedcf13 100644
--- a/tests/issue1987.sh
+++ b/tests/issue1987.sh
@@ -93,7 +93,7 @@ PATCHES_DIR_AFTER_OPTIMIZE=$(ls -1 $PATCHES_DIR)
 # i.e., must be equal to $PATCH.
 # Otherwise $REMOVED_PATCH == '', and then $REMOVED_PATCH != $PATCH.
 REMOVED_PATCH=`comm -13 <(echo "$PATCHES_DIR_AFTER_OPTIMIZE") \
-						<(echo "$PATCHES_DIR_AFTER_AMEND")`
+                        <(echo "$PATCHES_DIR_AFTER_AMEND")`
 
 [ "$PATCH" == "$REMOVED_PATCH" ]
 
@@ -130,7 +130,7 @@ INV_DIR_AFTER_SND_RECORD=$(ls -1 $INV_DIR)
 # $SND_PATCH should looks like:
 # 0000000384-e5683733407c4aae642604adf29d582a8fbbb6c50a96d6e8bba20058f7892b68
 SND_PATCH=`comm -13 <(echo "$INV_DIR_AFTER_RECORD") \
-					<(echo "$INV_DIR_AFTER_SND_RECORD")`
+                    <(echo "$INV_DIR_AFTER_SND_RECORD")`
 
 # We don't need any of the files in $INV_DIR (since we have not done
 # 'darcs tag', all the information is in _darcs/hashed_inventory),
@@ -174,7 +174,7 @@ INV_DIR_AFTER_TAG=$(ls -1 $INV_DIR)
 # $SND_PATCH should looks like:
 # 0000000297-eed3c68ee2d145f499f00d8367ec09a2cebdf79de7341e873e7bc68088236fc6
 SND_PATCH=`comm -13 <(echo "$INV_DIR_AFTER_RECORD") \
-					<(echo "$INV_DIR_AFTER_TAG")`
+                    <(echo "$INV_DIR_AFTER_TAG")`
 
 touch g
 darcs add g
@@ -202,7 +202,7 @@ INV_DIR_AFTER_OPTIMIZE=$(ls -1 $INV_DIR)
 # comm -3 is the symmetric difference i.e. union \\ intersection,
 # the extra echo gets rid of the whitespace
 NULL_INV=$(echo $(comm -3 <(echo "$INV_DIR_AFTER_OPTIMIZE") \
-					<(echo "$INV_DIR_AFTER_RECORD")))
+                          <(echo "$INV_DIR_AFTER_RECORD")))
 
 [ "$NULL_INV" = "0000000000-e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" ]
 
@@ -234,7 +234,7 @@ darcs record -am 'Hello darcs.'
 PRISTINE_DIR_AFTER_RECORD=$(ls -1 $PRISTINE_DIR)
 
 EXPECTED_PRISTINE_AFTER_OPTIMIZE=`comm -13 <(echo "$PRISTINE_DIR_AFTER_INIT") \
-										   <(echo "$PRISTINE_DIR_AFTER_RECORD")`
+                                           <(echo "$PRISTINE_DIR_AFTER_RECORD")`
 darcs optimize clean
 
 PRISTINE_DIR_AFTER_OPTIMIZE=$(ls -1 $PRISTINE_DIR)
diff --git a/tests/issue2209-look_for_replaces.sh b/tests/issue2209-look_for_replaces.sh
index 8f54c59c..63b91838 100644
--- a/tests/issue2209-look_for_replaces.sh
+++ b/tests/issue2209-look_for_replaces.sh
@@ -35,12 +35,12 @@ echo "foo" > file
 darcs record -al -m "add file"
 echo "bar_longer" > file          # replace by token of different length
 echo yy | darcs record --look-for-replaces -m "replace foo bar_longer file"
-darcs changes --last 1 -v 2>&1 | tail -n +4  > log
+darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -vw hash > log
 cat > log.expected <<EOF
   * replace foo bar_longer file
     replace ./file [A-Za-z_0-9] foo bar_longer
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # simple full complete replace (amend-record)
@@ -49,7 +49,7 @@ echo "foo" > file
 darcs record -al -m "add file"
 echo "bar" > file
 echo yyy | darcs amend-record --look-for-replaces
-darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" > log
+darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" | grep -vw hash > log
 cat > log.expected <<EOF
   * add file
     addfile ./file
@@ -57,7 +57,7 @@ cat > log.expected <<EOF
     +foo
     replace ./file [A-Za-z_0-9] foo bar
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # simple full complete replace (whatsnew)
@@ -65,11 +65,11 @@ darcs init
 echo "foo" > file
 darcs record -al -m "add file"
 echo "bar" > file
-darcs whatsnew --look-for-replaces 2>&1 > log
+darcs whatsnew --look-for-replaces 2>&1 | grep -vw hash > log
 cat > log.expected <<EOF
 replace ./file [A-Za-z_0-9] foo bar
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # partial replace (only some of the words/chunks replaced) (record)
@@ -78,7 +78,7 @@ echo "foo foo" > file
 darcs record -al -m "add file"
 echo "bar foo" > file
 echo yyy | darcs record --look-for-replaces -m "replace foo bar file"
-darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" > log
+darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" | grep -vw hash > log
 cat > log.expected <<EOF
   * replace foo bar file
     replace ./file [A-Za-z_0-9] foo bar
@@ -86,7 +86,7 @@ cat > log.expected <<EOF
     -bar bar
     +bar foo
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # partial replace (only some of the words/chunks replaced) (amend-record)
@@ -105,14 +105,14 @@ echo "foo foo" > file
 darcs record -al -m "add file"
 echo "bar foo" > file
 echo yyyy | darcs amend-record --look-for-replaces
-darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" > log
+darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" | grep -vw hash > log
 cat > log.expected <<EOF
   * add file
     addfile ./file
     hunk ./file 1
     +bar foo
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # partial replace (only some of the words/chunks replaced) (whatsnew)
@@ -120,14 +120,14 @@ darcs init
 echo "foo foo" > file
 darcs record -al -m "add file"
 echo "bar foo" > file
-darcs whatsnew --look-for-replaces > log
+darcs whatsnew --look-for-replaces | grep -vw hash > log
 cat > log.expected <<EOF
 replace ./file [A-Za-z_0-9] foo bar
 hunk ./file 1
 -bar bar
 +bar foo
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # forced replace (the word is in the file) (record)
@@ -144,7 +144,7 @@ bar
 bar
 EOF
 echo yyy | darcs record --look-for-replaces -m "replace foo bar file"
-darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" > log
+darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" | grep -vw hash > log
 cat > log.expected <<EOF
   * replace foo bar file
     hunk ./file 3
@@ -152,7 +152,7 @@ cat > log.expected <<EOF
     +foo
     replace ./file [A-Za-z_0-9] foo bar
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # forced replace (the word is in the file) (amend-record)
@@ -175,7 +175,7 @@ bar
 bar
 EOF
 echo yyyy | darcs amend-record --look-for-replaces
-darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" > log
+darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" | grep -vw hash > log
 cat > log.expected <<EOF
   * change file
     hunk ./file 3
@@ -183,7 +183,7 @@ cat > log.expected <<EOF
     +foo
     replace ./file [A-Za-z_0-9] foo bar
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # forced replace (the word is in the file) (whatsnew)
@@ -199,14 +199,14 @@ bar
 bar
 bar
 EOF
-darcs whatsnew --look-for-replaces 2>&1 > log
+darcs whatsnew --look-for-replaces 2>&1 | grep -vw hash > log
 cat > log.expected <<EOF
 hunk ./file 3
 -bar
 +foo
 replace ./file [A-Za-z_0-9] foo bar
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # multiple replaces (record)
@@ -223,14 +223,14 @@ rur
 kee
 EOF
 echo yyyy | darcs record --look-for-replaces -m "multiple replaces"
-darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" > log
+darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" | grep -vw hash > log
 cat > log.expected <<EOF
   * multiple replaces
     replace ./file [A-Za-z_0-9] bar rur
     replace ./file [A-Za-z_0-9] foo ter
     replace ./file [A-Za-z_0-9] ser kee
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # multiple replaces (amend-record)
@@ -247,7 +247,7 @@ rur
 kee
 EOF
 echo yyyyy | darcs amend-record --look-for-replaces
-darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" > log
+darcs changes --last 1 -v 2>&1 | tail -n +4 | grep -v "^    {\|    }$" | grep -vw hash > log
 cat > log.expected <<EOF
   * add file
     addfile ./file
@@ -259,7 +259,7 @@ cat > log.expected <<EOF
     replace ./file [A-Za-z_0-9] foo ter
     replace ./file [A-Za-z_0-9] ser kee
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # multiple replaces (whatsnew)
@@ -275,13 +275,13 @@ ter
 rur
 kee
 EOF
-darcs whatsnew --look-for-replaces 2>&1 > log
+darcs whatsnew --look-for-replaces 2>&1 | grep -vw hash > log
 cat > log.expected <<EOF
 replace ./file [A-Za-z_0-9] bar rur
 replace ./file [A-Za-z_0-9] foo ter
 replace ./file [A-Za-z_0-9] ser kee
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # conflicting replaces (whatsnew)
@@ -295,7 +295,7 @@ cat > file <<EOF
 bar
 ber
 EOF
-darcs whatsnew --look-for-replaces 2>&1 > log
+darcs whatsnew --look-for-replaces 2>&1 | grep -vw hash > log
 cat > log.expected <<EOF
 hunk ./file 1
 -foo
@@ -303,7 +303,7 @@ hunk ./file 1
 +bar
 +ber
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # same line replaces
@@ -317,7 +317,7 @@ cat > file <<EOF
 bar bar2 bar3
 bor bor2 bor3
 EOF
-darcs whatsnew --look-for-replaces 2>&1 > log
+darcs whatsnew --look-for-replaces 2>&1 | grep -vw hash > log
 cat > log.expected <<EOF
 replace ./file [A-Za-z_0-9] fee bor
 replace ./file [A-Za-z_0-9] fee2 bor2
@@ -326,7 +326,7 @@ replace ./file [A-Za-z_0-9] foo bar
 replace ./file [A-Za-z_0-9] foo2 bar2
 replace ./file [A-Za-z_0-9] foo3 bar3
 EOF
-diff -u log log.expected
+diff -u log log.expected >&2
 rm -rf *
 
 # 2
diff --git a/tests/issue2312_posthooks_for_record_and_amend-record_should_receive_DARCS_PATCHES.sh b/tests/issue2312_posthooks_should_receive_DARCS_PATCHES.sh
similarity index 100%
rename from tests/issue2312_posthooks_for_record_and_amend-record_should_receive_DARCS_PATCHES.sh
rename to tests/issue2312_posthooks_should_receive_DARCS_PATCHES.sh
diff --git a/tests/issue2333.sh b/tests/issue2333.sh
old mode 100644
new mode 100755
diff --git a/tests/issue2382-mv-dir-to-file-confuses-darcs.sh b/tests/issue2382-mv-dir-to-file-confuses-darcs.sh
index c42f7683..8415b9b1 100644
--- a/tests/issue2382-mv-dir-to-file-confuses-darcs.sh
+++ b/tests/issue2382-mv-dir-to-file-confuses-darcs.sh
@@ -27,7 +27,7 @@
 function getRecordedChanges () {
 darcs rec -am 1
 # Ignore patch details and unindent - we should have the same contents as wh
-darcs changes --last 1 -v | tail -n+5 | sed -e 's/^\s\+//' | grep -v '^[{}]$' > $1
+darcs changes --last 1 -v | tail -n+5 | sed -e 's/^\s\+//' | grep -v '^[{}]$' | grep -vw hash > $1
 darcs unrecord --last 1 -a
 }
 
@@ -59,23 +59,23 @@ hunk ./foo 1
 rmfile ./foo
 EOF
 
-diff whoutput1 expected1
+diff whoutput1 expected1 >&2
 
 # Ensure recording everything isn't any different to asking whatsnew
 getRecordedChanges recoutput1
-diff recoutput1 expected1
+diff recoutput1 expected1 >&2
 rmOutputFiles
 
 # To avoid the output file appearing in the output of wh -l
 whl=$(darcs wh -l)
 echo "$whl" > whoutput2
 cat << EOF > expected2
-R ./foo
+R ./foo -1
 a ./foo/
 a ./foo/bar
 EOF
 
-diff whoutput2 expected2
+diff -u whoutput2 expected2 >&2
 
 darcs add foo
 
@@ -87,9 +87,9 @@ rmfile ./foo
 adddir ./foo
 EOF
 
-diff whoutput3 expected3
+diff whoutput3 expected3 >&2
 getRecordedChanges recoutput3
-diff recoutput3 expected3
+diff recoutput3 expected3 >&2
 rmOutputFiles
 
 darcs add foo/bar
@@ -103,9 +103,9 @@ adddir ./foo
 addfile ./foo/bar
 EOF
 
-diff whoutput4 expected4
+diff whoutput4 expected4 >&2
 getRecordedChanges recoutput4
-diff recoutput4 expected4
+diff recoutput4 expected4 >&2
 
 # Make sure we can remove the directory, without modifying working
 darcs remove foo/bar
@@ -115,8 +115,8 @@ darcs add -r foo
 darcs wh > whoutput4a
 getRecordedChanges recoutput4a
 
-diff whoutput4a expected4
-diff recoutput4a expected4
+diff whoutput4a expected4 >&2
+diff recoutput4a expected4 >&2
 rmOutputFiles
 
 # Make sure foo is now recorded as a directory
@@ -133,9 +133,9 @@ rmfile ./foo/bar
 rmdir ./foo
 EOF
 
-diff whoutput5 expected5
+diff whoutput5 expected5 >&2
 getRecordedChanges recoutput5
-diff recoutput5 expected5
+diff recoutput5 expected5 >&2
 rmOutputFiles
 
 darcs rev -a
@@ -151,9 +151,9 @@ cat << EOF > expected6
 rmdir ./bar
 EOF
 
-diff whoutput6 expected6
+diff whoutput6 expected6 >&2
 getRecordedChanges recoutput6
-diff recoutput6 expected6
+diff recoutput6 expected6 >&2
 rmOutputFiles
 
 whl=$(darcs wh -l)
@@ -164,7 +164,7 @@ R ./bar/
 a ./bar
 EOF
 
-diff whoutput7 expected7
+diff whoutput7 expected7 >&2
 
 darcs add bar
 
@@ -174,7 +174,7 @@ rmdir ./bar
 addfile ./bar
 EOF
 
-diff whoutput8 expected8
+diff whoutput8 expected8 >&2
 getRecordedChanges recoutput8
-diff recoutput8 expected8
+diff recoutput8 expected8 >&2
 rmOutputFiles
diff --git a/tests/issue2556-apply-fails-for-large-bundle.sh b/tests/issue2556-apply-fails-for-large-bundle.sh
old mode 100644
new mode 100755
diff --git a/tests/issue2727-resolutions-order-independent1.sh b/tests/issue2727-resolutions-order-independent1.sh
old mode 100644
new mode 100755
diff --git a/tests/issue2727-resolutions-order-independent10.sh b/tests/issue2727-resolutions-order-independent10.sh
old mode 100644
new mode 100755
diff --git a/tests/issue2727-resolutions-order-independent11.sh b/tests/issue2727-resolutions-order-independent11.sh
old mode 100644
new mode 100755
diff --git a/tests/issue2727-resolutions-order-independent2.sh b/tests/issue2727-resolutions-order-independent2.sh
old mode 100644
new mode 100755
diff --git a/tests/issue2727-resolutions-order-independent3.sh b/tests/issue2727-resolutions-order-independent3.sh
old mode 100644
new mode 100755
diff --git a/tests/issue2727-resolutions-order-independent4.sh b/tests/issue2727-resolutions-order-independent4.sh
old mode 100644
new mode 100755
diff --git a/tests/issue2727-resolutions-order-independent5.sh b/tests/issue2727-resolutions-order-independent5.sh
old mode 100644
new mode 100755
diff --git a/tests/issue2727-resolutions-order-independent6.sh b/tests/issue2727-resolutions-order-independent6.sh
old mode 100644
new mode 100755
diff --git a/tests/issue2727-resolutions-order-independent7.sh b/tests/issue2727-resolutions-order-independent7.sh
old mode 100644
new mode 100755
diff --git a/tests/issue2727-resolutions-order-independent8.sh b/tests/issue2727-resolutions-order-independent8.sh
old mode 100644
new mode 100755
diff --git a/tests/issue2727-resolutions-order-independent9.sh b/tests/issue2727-resolutions-order-independent9.sh
old mode 100644
new mode 100755
diff --git a/tests/network/clone-http-packed-detect.sh b/tests/network/clone-http-packed-detect.sh
index 2d4f6301..c3d48fe1 100644
--- a/tests/network/clone-http-packed-detect.sh
+++ b/tests/network/clone-http-packed-detect.sh
@@ -22,15 +22,15 @@ serve_http # sets baseurl
 
 # check that default behaviour is to get packs
 rm -rf S
-darcs clone $baseurl/repo S --verbose |grep "Cloning packed basic repository"
+darcs clone $baseurl/repo S --verbose | grep "Trying to clone packed basic repository"
 
 # check that it does really not get packs when --no-packs is passed
 rm -rf S
-darcs clone $baseurl/repo S --no-packs --verbose  |not grep "Cloning packed basic repository"
+darcs clone $baseurl/repo S --no-packs --verbose | not grep "Trying to clone packed basic repository"
 
 # check that it does not claim getting packs when there are not
 rm -rf S
 rm -rf repo/_darcs/packs/
 # sleep for a second to avoid spurious false positives on MacOS:
 sleep 1
-darcs clone $baseurl/repo S --verbose |not grep "Cloning packed basic repository"
+darcs clone $baseurl/repo S --verbose | grep "Remote repo has no basic pack"
diff --git a/tests/network/failing-issue2462-remote-darcs-transfer-mode.sh b/tests/network/failing-issue2462-remote-darcs-transfer-mode.sh
new file mode 100644
index 00000000..4c41cacb
--- /dev/null
+++ b/tests/network/failing-issue2462-remote-darcs-transfer-mode.sh
@@ -0,0 +1,11 @@
+#!/usr/bin/env bash
+
+. lib
+. sshlib
+
+init_remote_repo R
+
+rm -rf R
+darcs clone --remote-darcs=xyzabc "${REMOTE}:${REMOTE_DIR}/R" --debug 2>LOG
+grep '"ssh" .* "xyzabc"' LOG
+not grep '"ssh" .* "darcs"' LOG
diff --git a/tests/pull.sh b/tests/pull.sh
index c6f4d77c..82b256f7 100644
--- a/tests/pull.sh
+++ b/tests/pull.sh
@@ -101,19 +101,17 @@ echo -n bar > correct_baz
 diff baz correct_baz
 cd ..
 
-#   my $test_name = "when a patch creating a directory is attempted to be applied
-#       while a directory with that name already exists, a warning is raised, but
-#       the pull succeeds.";
+# When a patch creating a directory is attempted to be applied while a
+# directory with that name already exists, but has not been added, the pull
+# succeeds (if there are no further conflicts inside that directory).
 mkdir temp1/newdir
 cd temp1
 darcs add newdir
 darcs record -am newdir
 cd ../temp2
 mkdir newdir
-darcs pull -a --set-default ../temp1 &> out2
-grep Backing out2
+darcs pull -a ../temp1 > out2
 grep 'Finished pulling' out2
-grep newdir out2
 cd ..
 
 rm -rf temp1 temp2
diff --git a/tests/failing-pristine-problems.sh b/tests/repair-missing-pristine-files.sh
old mode 100644
new mode 100755
similarity index 88%
rename from tests/failing-pristine-problems.sh
rename to tests/repair-missing-pristine-files.sh
index 7fae8780..27e2607a
--- a/tests/failing-pristine-problems.sh
+++ b/tests/repair-missing-pristine-files.sh
@@ -39,15 +39,17 @@ roothash=`darcs show pristine | grep ' ./$' | cut -d' ' -f1`
 wibblehash=`darcs show pristine | grep ' wibble$' | cut -d' ' -f1`
 
 rm _darcs/pristine.hashed/$roothash
+# also remove it from the cache
+find $HOME/.cache/darcs/pristine.hashed -name $roothash -exec rm -f {} \; || true
 
 not darcs check
 not darcs check
-# At the time of writing this test goes wrong at the line above
-# I'm not 100% certain if the rest of it is right.
 darcs repair | grep -v 'The repository is already consistent'
 darcs check
 
 rm _darcs/pristine.hashed/$wibblehash
+# also remove it from the cache
+find $HOME/.cache/darcs/pristine.hashed -name $wibblehash -exec rm -f {} \; || true
 
 not darcs check
 not darcs check
diff --git a/tests/repair.sh b/tests/repair.sh
index d600a870..18ce48fb 100644
--- a/tests/repair.sh
+++ b/tests/repair.sh
@@ -51,6 +51,7 @@ darcs record -lam moo
 darcs repair | grep 'already consistent'
 cd ..
 
+# TODO [V3INTEGRATION]
 # We cannot currently implement repair for the darcs-3 format
 # because that risks inconsistencies in conflictors that refer
 # to removed or added prims. Fixing this requires refactoring
diff --git a/tests/resolve-conflicts-explicitly.sh b/tests/resolve-conflicts-explicitly.sh
old mode 100644
new mode 100755
diff --git a/tests/send-output-v2.sh b/tests/send-output-v2.sh
deleted file mode 100644
index 70c27510..00000000
--- a/tests/send-output-v2.sh
+++ /dev/null
@@ -1,51 +0,0 @@
-#!/usr/bin/env bash
-
-## Test that we produce exactly correct output when sending v2 patches
-##
-## Copyright (C) 2010 Ganesh Sittampalam
-##
-## Permission is hereby granted, free of charge, to any person
-## obtaining a copy of this software and associated documentation
-## files (the "Software"), to deal in the Software without
-## restriction, including without limitation the rights to use, copy,
-## modify, merge, publish, distribute, sublicense, and/or sell copies
-## of the Software, and to permit persons to whom the Software is
-## furnished to do so, subject to the following conditions:
-##
-## The above copyright notice and this permission notice shall be
-## included in all copies or substantial portions of the Software.
-##
-## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
-## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
-## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
-## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-## SOFTWARE.
-
-. lib                  # Load some portability helpers.
-
-only-format darcs-2
-
-rm -rf empty
-mkdir empty
-cd empty
-darcs init
-cd ..
-
-rm -rf repo
-unpack_testdata simple-v2
-cd repo
-darcs send --no-minimize -o repo.dpatch -a ../empty
-
-compare_bundles $TESTDATA/simple-v2.dpatch repo.dpatch
-cd ..
-
-# context-v2 tests that we are including some context lines in hunk patches
-rm -rf repo
-unpack_testdata context-v2
-cd repo
-darcs send --no-minimize -o repo.dpatch -a ../empty
-compare_bundles $TESTDATA/context-v2.dpatch repo.dpatch
-cd ..
diff --git a/tests/send-output-v1.sh b/tests/send-output.sh
similarity index 77%
rename from tests/send-output-v1.sh
rename to tests/send-output.sh
index 55e0fc86..492c0f11 100644
--- a/tests/send-output-v1.sh
+++ b/tests/send-output.sh
@@ -1,6 +1,6 @@
 #!/usr/bin/env bash
 
-## Test that we produce exactly correct output when sending v1 patches
+## Test that we produce exactly correct output when sending
 ##
 ## Copyright (C) 2010 Ganesh Sittampalam
 ##
@@ -24,9 +24,19 @@
 ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
 ## SOFTWARE.
 
-. lib                  # Load some portability helpers.
+. lib
 
-only-format darcs-1
+case $format in
+  darcs-1)
+    v=v1
+    ;;
+  darcs-2)
+    v=v2
+    ;;
+  darcs-3)
+    v=v3
+    ;;
+esac
 
 rm -rf empty
 mkdir empty
@@ -35,18 +45,17 @@ darcs init
 cd ..
 
 rm -rf repo
-unpack_testdata simple-v1
+unpack_testdata simple-$v
 cd repo
 darcs send --no-minimize -o repo.dpatch -a ../empty
 
-compare_bundles $TESTDATA/simple-v1.dpatch repo.dpatch
+compare_bundles $TESTDATA/simple-$v.dpatch repo.dpatch
 cd ..
 
-# context-v1 tests that we are including some context lines in hunk patches
+# test that we are including some context lines in hunk patches
 rm -rf repo
-unpack_testdata context-v1
+unpack_testdata context-$v
 cd repo
 darcs send --no-minimize -o repo.dpatch -a ../empty
-
-compare_bundles $TESTDATA/context-v1.dpatch repo.dpatch
+compare_bundles $TESTDATA/context-$v.dpatch repo.dpatch
 cd ..