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