darcs

Issue 2092 error applying hunk in darcs record

Title error applying hunk in darcs record
Priority bug Status given-up
Milestone Resolved in
Superseder Nosy List mornfall
Assigned To
Topics

Created on 2011-07-23.19:35:40 by mornfall, last changed 2020-07-31.20:42:11 by bfrk.

Messages
msg14600 (view) Author: mornfall Date: 2011-07-23.19:35:38
17:09:30 | morn@ald:~/dev/darcs/prims-v3 -> darcs rec ./src/Darcs/Test/
Recording changes in "src/Darcs/Test":

hunk ./src/Darcs/Test/Patch.hs 216
-                                  RepoState (ModelOf prim) ~ ApplyState prim)
+                                  RepoState (ModelOf prim) ~ ApplyState prim
+                                  {-, (Arbitrary
+                                   (Sealed (WithState (ModelOf prim) (RealPatch 
prim) a)))-} )
Shall I record this change? (1/49)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/Arbitrary/Generic.hs 27
-import Darcs.Patch.Patchy ( Invert(..), Commute(..) )
+import Darcs.Patch.Patchy ( Invert(..), Commute(..), Apply )
Shall I record this change? (2/49)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV1.hs 231
-       let Just repo' = repoApply repo patch
+       let repo' = unFail $ repoApply repo patch
Shall I record this change? (3/49)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV1.hs 285
-                 let Just repo'  = repoApply repo p1
-                     Just repo'' = repoApply repo' p2
+                 let repo'  = unFail $ repoApply repo p1
+                     repo'' = unFail $ repoApply repo' p2
Shall I record this change? (4/49)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 34
+import qualified Data.Map as M
+import Storage.Hashed.Hash( Hash(..) )
Shall I record this change? (5/49)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 104
-aTextHunk :: FORALL (x y) (UUID, Object Maybe) -> Gen (Prim C(x y))
-aTextHunk (uuid, (File text)) =
-  do hunk <- aHunk text
+aTextHunk :: FORALL (x y) (UUID, Object Fail) -> Gen (Prim C(x y))
+aTextHunk (uuid, (Blob text _)) =
+  do hunk <- aHunk (unFail text)
Shall I record this change? (6/49)  [ynW...], or ? for more options: e
Waiting for Emacs...
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 104
-aTextHunk :: FORALL (x y) (UUID, Object Maybe) -> Gen (Prim C(x y))
+aTextHunk :: FORALL (x y) (UUID, Object Fail) -> Gen (Prim C(x y))
Shall I record this change? (6/51)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 106
-  do hunk <- aHunk text
+  do hunk <- aHunk (unFail text)
Shall I record this change? (7/51)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 105
-aTextHunk (uuid, (File text)) =
+aTextHunk (uuid, (Blob text _)) =
Shall I record this change? (8/51)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 109
-aManifest :: FORALL (x y) UUID -> Location -> Object Maybe -> Gen (Prim C(x y))
-aManifest uuid loc (Dir dir) =
-  do newFilename <- aFilename `notIn` (map snd dir)
+aManifest :: FORALL (x y) UUID -> Location -> Object Fail -> Gen (Prim C(x y))
+aManifest uuid loc (Directory dir) =
+  do newFilename <- aFilename `notIn` (M.keys dir)
Shall I record this change? (9/51)  [ynW...], or ? for more options: e
Waiting for Emacs...
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 109
-aManifest :: FORALL (x y) UUID -> Location -> Object Maybe -> Gen (Prim C(x y))
+aManifest :: FORALL (x y) UUID -> Location -> Object Fail -> Gen (Prim C(x y))
Shall I record this change? (9/52)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 110
-aManifest uuid loc (Dir dir) =
-  do newFilename <- aFilename `notIn` (map snd dir)
+aManifest uuid loc (Directory dir) =
+  do newFilename <- aFilename `notIn` (M.keys dir)
Shall I record this change? (10/52)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 134
-                  , ( 2, aTextHunk (fresh, File "") ) -- create an empty thing
+                  , ( 2, aTextHunk (fresh, Blob (return "") NoHash) ) -- create an 
empty thing
Shall I record this change? (11/52)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 142
-       let Just repo' = repoApply repo patch
+       let repo' = unFail $ repoApply repo patch
Shall I record this change? (12/52)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 145
-      manifested = [ (id, (dirid, name)) | (dirid, Dir dir) <- repoDirs, (id, name) 
<- dir ]
-      repoFiles = [ (id, File x) | (id, File x) <- repoObjects repo ]
-      repoDirs  = [ (id, Dir x) | (id, Dir x) <- repoObjects repo ]
+      manifested = [ (id, (dirid, name)) | (dirid, Directory dir) <- repoDirs
+                                         , (name, id) <- M.toList dir ]
+      repoFiles = [ (id, Blob x y) | (id, Blob x y) <- repoObjects repo ]
+      repoDirs  = [ (id, Directory x) | (id, Directory x) <- repoObjects repo ]
Shall I record this change? (13/52)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 155
-hunkPair :: FORALL(x y) (UUID, Object Maybe) -> Gen ((Prim :> Prim) C(x y))
-hunkPair (uuid, (File file)) =
-  do h1@(Hunk l1 old1 new1) <- aHunk file
-     (delta, content') <- selectChunk h1 file
+hunkPair :: FORALL(x y) (UUID, Object Fail) -> Gen ((Prim :> Prim) C(x y))
+hunkPair (uuid, (Blob file _)) =
+  do h1@(Hunk l1 old1 new1) <- aHunk (unFail file)
+     (delta, content') <- selectChunk h1 (unFail file)
Shall I record this change? (14/52)  [ynW...], or ? for more options: e
Waiting for Emacs...
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 155
-hunkPair :: FORALL(x y) (UUID, Object Maybe) -> Gen ((Prim :> Prim) C(x y))
+hunkPair :: FORALL(x y) (UUID, Object Fail) -> Gen ((Prim :> Prim) C(x y))
Shall I record this change? (14/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 157
-  do h1@(Hunk l1 old1 new1) <- aHunk file
-     (delta, content') <- selectChunk h1 file
+  do h1@(Hunk l1 old1 new1) <- aHunk (unFail file)
+     (delta, content') <- selectChunk h1 (unFail file)
Shall I record this change? (15/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 156
-hunkPair (uuid, (File file)) =
+hunkPair (uuid, (Blob file _)) =
Shall I record this change? (16/54)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 175
-                 let Just repo'  = repoApply repo  p1
-                     Just repo'' = repoApply repo' p2
+                 let repo'  = unFail $ repoApply repo  p1
+                     repo'' = unFail $ repoApply repo' p2
Shall I record this change? (17/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Arbitrary/PrimV3.hs 185
-      repoFiles = [ (id, File x) | (id, File x) <- repoObjects repo ]
+      repoFiles = [ (id, Blob x y) | (id, Blob x y) <- repoObjects repo ]
Shall I record this change? (18/54)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/Properties/Generic.hs 35
-import Darcs.Test.Patch.RepoModel ( RepoModel, RepoState, repoApply, eqModel, 
showModel )
+import Darcs.Test.Patch.RepoModel ( RepoModel, RepoState, repoApply, eqModel, 
showModel
+                                  , maybeFail, Fail )
Shall I record this change? (19/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Properties/Generic.hs 81
-  = case repoApply b (invert x) of
+  = case maybeFail $ repoApply b (invert x) of
Shall I record this change? (20/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Properties/Generic.hs 145
-      case repoApply r y' of
+      case maybeFail $ repoApply r y' of
Shall I record this change? (21/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Properties/Generic.hs 148
-        case repoApply r_y' x' of
+        case maybeFail $ repoApply r_y' x' of
Shall I record this change? (22/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Properties/Generic.hs 329
-       Just x  -> case repoApply r x of
+       Just x  -> case maybeFail $ repoApply r x of
Shall I record this change? (23/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Properties/Real.hs 6
-import Darcs.Test.Patch.RepoModel ( RepoModel, repoApply, showModel, eqModel, 
RepoState )
+import Darcs.Test.Patch.RepoModel ( RepoModel, repoApply, showModel, eqModel, 
RepoState
+                                  , Fail, maybeFail )
Shall I record this change? (24/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Properties/Real.hs 17
-assertEqualFst :: (RepoModel a, Show b, Show c) => (Maybe (a x), b) -> (Maybe (a x), 
c) -> Bool
+assertEqualFst :: (RepoModel a, Show b, Show c) => (Fail (a x), b) -> (Fail (a x), 
c) -> Bool
Shall I record this change? (25/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Properties/Real.hs 19
-    | Just x' <- x, Just y' <- y, x' `eqModel` y' = True
-    | Nothing <- x, Nothing <- y = True
+    | Just x' <- maybeFail x, Just y' <- maybeFail y, x' `eqModel` y' = True
+    | Nothing <- maybeFail x, Nothing <- maybeFail y = True
Shall I record this change? (26/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Properties/Real.hs 23
-      where showx | Just x' <- x = showModel x'
+      where showx | Just x' <- maybeFail x = showModel x'
Shall I record this change? (27/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/Properties/Real.hs 25
-            showy | Just y' <- y = showModel y'
+            showy | Just y' <- maybeFail y = showModel y'
Shall I record this change? (28/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/RepoModel.hs 6
+type Fail = Either String
+unFail (Right x) = x
+unFail (Left err) = error $ "unFail failed: " ++ err
+
+maybeFail (Right x) = Just x
+maybeFail _ = Nothing
+
Shall I record this change? (29/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/RepoModel.hs 18
-  repoApply :: (Apply p, ApplyState p ~ RepoState model) => model x -> p x y -> 
Maybe (model y)
+  repoApply :: (Apply p, ApplyState p ~ RepoState model) => model x -> p x y -> Fail 
(model y)
Shall I record this change? (30/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/V1Model.hs 62
-                           repoTree :: Tree Maybe
+                           repoTree :: Tree Fail
Shall I record this change? (31/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/V1Model.hs 68
-                      treeItem :: TreeItem Maybe
+                      treeItem :: TreeItem Fail
Shall I record this change? (32/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/V1Model.hs 149
-  = case T.readBlob blob of
-         Nothing -> error "fileContent: No content."
-         Just c  -> lbs2content c
+  = lbs2content $ unFail $ T.readBlob blob
Shall I record this change? (33/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/V1Model.hs 193
-  let Just (diff1,diff2) = T.diffTrees hashedTree1 hashedTree2
+  let (diff1,diff2) = unFail $ T.diffTrees hashedTree1 hashedTree2
Shall I record this change? (34/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/V1Model.hs 196
-      hashedTree1 = fromJust $ darcsUpdateHashes $ repoTree repo1
-      hashedTree2 = fromJust $ darcsUpdateHashes $ repoTree repo2
+      hashedTree1, hashedTree2 :: Tree Fail
+      hashedTree1 = unFail $ darcsUpdateHashes $ repoTree repo1
+      hashedTree2 = unFail $ darcsUpdateHashes $ repoTree repo2
Shall I record this change? (35/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/V3Model.hs 1
-{-# LANGUAGE CPP, OverloadedStrings, MultiParamTypeClasses #-}
+{-# LANGUAGE CPP, OverloadedStrings, MultiParamTypeClasses, StandaloneDeriving #-}
Shall I record this change? (36/54)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/V3Model.hs 37
+import Storage.Hashed.Hash( Hash(..) )
Shall I record this change? (37/54)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/V3Model.hs 58
-newtype V3Model C(x) = V3Model { repoMap :: ObjectMap Maybe }
+newtype V3Model C(x) = V3Model { repoMap :: ObjectMap Fail }
Shall I record this change? (38/54)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/V3Model.hs 63
-instance Show (Object m) where
-  show (Dir l) = show l
-  show (File c) = BC.unpack c
+instance Show (Object Fail) where
+  show (Directory l) = show l
+  show (Blob c _) = show c
+
+deriving instance Eq (Object Fail)
Shall I record this change? (39/54)  [ynW...], or ? for more options: k
hunk ./src/Darcs/Test/Patch/V3Model.hs 58
-newtype V3Model C(x) = V3Model { repoMap :: ObjectMap Maybe }
+newtype V3Model C(x) = V3Model { repoMap :: ObjectMap Fail }
Shall I record this change? (38/54)  [yNw...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/V3Model.hs 63
-instance Show (Object m) where
-  show (Dir l) = show l
-  show (File c) = BC.unpack c
+instance Show (Object Fail) where
+  show (Directory l) = show l
+  show (Blob c _) = show c
+
+deriving instance Eq (Object Fail)
Shall I record this change? (39/54)  [ynW...], or ? for more options: e
Waiting for Emacs...
hunk ./src/Darcs/Test/Patch/V3Model.hs 63
-instance Show (Object m) where
-  show (Dir l) = show l
+instance Show (Object Fail) where
+  show (Directory l) = show l
Shall I record this change? (39/56)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/V3Model.hs 66
+
+deriving instance Eq (Object Fail)
Shall I record this change? (40/56)  [ynW...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/V3Model.hs 65
-  show (File c) = BC.unpack c
+  show (Blob c _) = show c
Shall I record this change? (41/56)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/V3Model.hs 78
+objectMap :: (Monad m) => M.Map UUID (Object m) -> ObjectMap m
+objectMap map = ObjectMap { getObject = get, putObject = put, listObjects = list }
+  where list = return $ M.keys map
+        put k o = return $ objectMap (M.insert k o map)
+        get k = return $ M.lookup k map
+
Shall I record this change? (42/56)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/V3Model.hs 85
-emptyRepo = V3Model (ObjectMap M.empty)
+emptyRepo = V3Model (objectMap M.empty)
Shall I record this change? (43/56)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/V3Model.hs 87
-emptyFile :: Object m
-emptyFile = File BS.empty
+emptyFile :: (Monad m) => Object m
+emptyFile = Blob (return BS.empty) NoHash
Shall I record this change? (44/56)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/V3Model.hs 91
-emptyDir = Dir []
+emptyDir = Directory M.empty
Shall I record this change? (45/56)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/V3Model.hs 96
-unmap (ObjectMap m) = m
-
Shall I record this change? (46/56)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/V3Model.hs 97
-nullRepo = M.null . unmap . repoMap
+nullRepo = null . unFail . listObjects . repoMap
Shall I record this change? (47/56)  [ynW...], or ? for more options: n
hunk ./src/Darcs/Test/Patch/V3Model.hs 101
-isEmpty :: Object m -> Bool
-isEmpty (Dir d) = null d
-isEmpty (File f) = BS.null f
+isEmpty :: Object Fail -> Bool
+isEmpty (Directory d) = M.null d
+isEmpty (Blob f _) = BS.null $ unFail f
Shall I record this change? (48/56)  [ynW...], or ? for more options: k
hunk ./src/Darcs/Test/Patch/V3Model.hs 97
-nullRepo = M.null . unmap . repoMap
+nullRepo = null . unFail . listObjects . repoMap
Shall I record this change? (47/56)  [yNw...], or ? for more options: y
hunk ./src/Darcs/Test/Patch/V3Model.hs 101
-isEmpty :: Object m -> Bool
-isEmpty (Dir d) = null d
-isEmpty (File f) = BS.null f
+isEmpty :: Object Fail -> Bool
+isEmpty (Directory d) = M.null d
+isEmpty (Blob f _) = BS.null $ unFail f
Shall I record this change? (48/56)  [ynW...], or ? for more options: k
hunk ./src/Darcs/Test/Patch/V3Model.hs 97
-nullRepo = M.null . unmap . repoMap
+nullRepo = null . unFail . listObjects . repoMap
Shall I record this change? (47/56)  [Ynw...], or ? for more options: e
Waiting for Emacs...
hunk ./src/Darcs/Test/Patch/V3Model.hs 97
-nullRepo = M.null . unmap . repoMap
+nullRepo = null . unFail . listObjects . repoMap
Shall I record this change? (47/56)  [Ynw...], or ? for more options: d
What is the patch name? Move from the Maybe to the Either String monad for testsuite.
Do you want to add a long comment? [yn]n
WARNING: Doing a one-time conversion of pristine format.
This may take a while. The new format is backwards-compatible.
Pristine conversion done...

darcs failed:  ### Error applying:
hunk ./src/Darcs/Test/Patch/V3Model.hs 97
-nullRepo = M.null . unmap . repoMap
+nullRepo = null . unFail . listObjects . repoMap
### to file ./src/Darcs/Test/Patch/V3Model.hs:
{-# LANGUAGE CPP, OverloadedStrings, MultiParamTypeClasses, StandaloneDeriving #-}

#include "gadts.h"

-- | Repository model
module Darcs.Test.Patch.V3Model
  ( module Storage.Hashed.AnchoredPath
  , V3Model
  , Object(..)
  , repoApply
  , emptyFile
  , emptyDir
  , nullRepo
  , isEmpty
  , root, repoObjects
  , aFilename, aDirname
  , aLine, aContent
  , aFile, aDir
  , aRepo
  , anUUID
  ) where


import Darcs.Test.Util.QuickCheck ( alpha, uniques, bSized )
import Darcs.Test.Patch.RepoModel

import Darcs.Patch.Apply( Apply(..), applyToState )
import Darcs.Patch.ApplyMonad( ApplyMonad(..) )
import Darcs.Patch.Prim.V3.Core( UUID(..), Hunk(..), Prim(..), Object(..) )
import Darcs.Patch.Prim.V3.Apply( ObjectMap(..) )
import Darcs.Witnesses.Sealed ( Sealed, seal )
import Darcs.Witnesses.Show

import Storage.Hashed.AnchoredPath
import Storage.Hashed.Tree( Tree, TreeItem )
import Storage.Hashed.Darcs ( darcsUpdateHashes )
import qualified Storage.Hashed.Tree as T

import Control.Applicative ( (<$>) )
import Control.Arrow ( second )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BLC
import Data.List ( intercalate, sort )
import qualified Data.Map as M
import Test.QuickCheck
  ( Arbitrary(..)
  , Gen, choose, vectorOf, frequency, oneof )

#include "impossible.h"


----------------------------------------------------------------------
-- * Model definition

newtype V3Model C(x) = V3Model { repoMap :: ObjectMap Fail }

----------------------------------------
-- Instances

instance Show (Object Fail) where
  show (Directory l) = show l
  show (File c) = BC.unpack c

deriving instance Eq (Object Fail)

instance Show (V3Model x) where
  show = showModel

instance Show1 V3Model where
  showDict1 = ShowDictClass

----------------------------------------------------------------------
-- * Constructors

emptyRepo :: V3Model C(x)
emptyRepo = V3Model (ObjectMap M.empty)

emptyFile :: Object m
emptyFile = File BS.empty

emptyDir :: Object m
emptyDir = Dir []

----------------------------------------------------------------------
-- * Queries

unmap (ObjectMap m) = m

nullRepo :: V3Model C(x) -> Bool
nullRepo = M.null . unmap . repoMap

-- | @isEmpty file@ <=> file content is empty
--   @isEmpty dir@  <=> dir has no child
isEmpty :: Object m -> Bool
isEmpty (Dir d) = null d
isEmpty (File f) = BS.null f

-- | The root directory of a repository.
root :: V3Model C(x) -> Object Maybe
root = fromJust . M.lookup (UUID "ROOT") . unmap . repoMap

repoObjects :: V3Model C(x) -> [(UUID, Object Maybe)]
repoObjects = M.toList . unmap . repoMap

----------------------------------------------------------------------
-- * Comparing repositories

----------------------------------------------------------------------
-- * QuickCheck generators

-- Testing code assumes that aFilename and aDirname generators 
-- will always be able to generate a unique name given a list of
-- existing names. This should be OK as long as the number of possible
-- file/dirnames is much bigger than the number of files/dirs per repository.

-- 'Arbitrary' 'V3Model' instance is based on the 'aSmallRepo' generator.


-- | Files are distinguish by ending their names with ".txt".
aFilename :: Gen BS.ByteString
aFilename = do len <- choose (1,maxLength)
               name <- vectorOf len alpha
               return $ BC.pack $ name ++ ".txt"
  where
      maxLength = 3

aDirname :: Gen BS.ByteString
aDirname = do len <- choose (1,maxLength)
              BC.pack <$> vectorOf len alpha
  where
      maxLength = 3

aWord :: Gen BS.ByteString
aWord = do c <- alpha
           return $ BC.pack[c]

aLine :: Gen BS.ByteString
aLine = do wordsNo <- choose (1,2)
           ws <- vectorOf wordsNo aWord
           return $ BC.unwords ws

aContent :: Gen BS.ByteString
aContent = bSized 0 0.5 80 $ \k ->
             do n <- choose (0,k)
                BC.intercalate "\n" <$> vectorOf n aLine

aFile :: Gen (Object m)
aFile = File <$> aContent

aDir :: [UUID] -> [UUID] -> Gen [(UUID, Object m)]
aDir [] _ = return []
aDir (dirid:dirids) fileids =
  do dirsplit <- choose (1, length dirids)
     filesplit <- choose (1, length fileids)
     let ids = take filesplit fileids
         rem = drop filesplit fileids
     files <- vectorOf filesplit aFile
     names <- vectorOf filesplit aFilename
     dirnames <- vectorOf dirsplit aDirname
     dirs <- subdirs (take dirsplit dirids)
                     (drop dirsplit dirids)
                     (drop filesplit fileids)
     return $ (dirid, Dir $ sort $ ids `zip` names ++ dirids `zip` dirnames)
            : (fileids `zip` files) ++ dirs
  where subdirs [] _ _ = return []
        subdirs tomake dirs files = do
          dirsplit <- choose (1, length dirs)
          filesplit <- choose (1, length files)
          dir <- aDir (head tomake : take dirsplit dirs) (take filesplit files)
          rem <- subdirs (tail tomake) (drop dirsplit dirs) (drop filesplit files)
          return $ dir ++ rem


anUUID :: Gen UUID
anUUID = UUID . BC.pack <$> vectorOf 32 (oneof $ map return "0123456789")

-- | @aRepo filesNo dirsNo@ produces repositories with *at most* 
-- @filesNo@ files and @dirsNo@ directories. 
-- The structure of the repository is aleatory.
aRepo :: Int                -- ^ Maximum number of files
        -> Int              -- ^ Maximum number of directories
        -> Gen (V3Model C(x))
aRepo maxFiles maxDirs
  = do let minFiles = if maxDirs == 0 && maxFiles > 0 then 1 else 0
       filesNo <- choose (minFiles,maxFiles)
       let minDirs = if filesNo == 0 && maxDirs > 0 then 1 else 0
       dirsNo <- choose (minDirs,maxDirs)
       dirids <- (UUID "ROOT":) <$> uniques dirsNo anUUID
       fileids <- uniques filesNo anUUID
       objectmap <- aDir dirids fileids
       return $ V3Model $ ObjectMap $ M.fromList objectmap

-- | Generate small repositories.
-- Small repositories help generating (potentially) conflicting patches.
instance RepoModel V3Model where
  type RepoState V3Model = ObjectMap
  aSmallRepo = do filesNo <- frequency [(3, return 1), (1, return 2)]
                  dirsNo <- frequency [(3, return 1), (1, return 0)]
                  aRepo filesNo dirsNo
  repoApply (V3Model state) patch = V3Model <$> applyToState patch state
  showModel (V3Model bits) = "V3Model{ " ++ unlines (map entry (M.toList $ unmap 
bits)) ++ " }"
    where entry (id, obj) = show id ++ " -> " ++ show obj
  eqModel r1 r2 = unmap (repoMap r1) == unmap (repoMap r2)

instance Arbitrary (Sealed V3Model) where
  arbitrary = seal <$> aSmallRepo

17:13:04 | morn@ald:~/dev/darcs/prims-v3 -> 

(I'll upload the repository as soon as I have an issue number for naming to the 
tarball.)
msg14601 (view) Author: mornfall Date: 2011-07-23.19:40:27
The repository in the state right after the failed record (this should be 
exactly the same as before the failed record) shall be shortly available 
at http://repos.mornfall.net/darcs/issue2092.tar.gz
msg14769 (view) Author: markstos Date: 2011-10-13.13:15:53
Thanks for the report. Which darcs version were you using at the time? Do 
darcs 2.5.1 and a current build produce the same result? (IE: is this a 
old issue or a new regression?)
msg22335 (view) Author: bfrk Date: 2020-07-31.20:42:08
cannot reproduce, the repo tar ball is no longer accessible
History
Date User Action Args
2011-07-23 19:35:40mornfallcreate
2011-07-23 19:40:27mornfallsetmessages: + msg14601
2011-10-13 13:15:53markstossetmessages: + msg14769
2012-01-01 23:08:47ganeshsetmilestone: 2.8.0 -> 2.8.1
2020-07-31 20:42:11bfrksetstatus: unknown -> given-up
messages: + msg22335
milestone: 2.8.1 ->