darcs

Issue 2092 error applying hunk in darcs record

Title error applying hunk in darcs record
Priority bug Status unknown
Milestone 2.8.1 Resolved in
Superseder Nosy List mornfall
Assigned To
Topics

Created on 2011-07-23.19:35:40 by mornfall, last changed 2012-01-01.23:08:47 by ganesh.

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?)
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