[darcs-devel] [patch1951] resolve 2616: Unbreak with base-4.13 — `Mon
M Farkas-Dyck
bugs at darcs.net
Tue Dec 31 13:00:45 UTC 2019
New submission from M Farkas-Dyck <strake888 at gmail.com>:
[patch] =?UTF-8?Q?adFail`?
Tested with "cabal test" and some actual use
1 patch for repository http://darcs.net/screened:
patch 2a862acd567de566d8ab37a39abba962afd6bc1d
Author: M Farkas-Dyck <strake888 at gmail.com>
Date: Mon Dec 23 17:05:39 -05 2019
* resolve 2616: Unbreak with base-4.13 — `MonadFail`
New patches:
[resolve 2616: Unbreak with base-4.13 — `MonadFail`
M Farkas-Dyck <strake888 at gmail.com>**20191223220539
Ignore-this: 3a61ca207d96cad11eaa80702c1cb390
] hunk ./darcs.cabal 110
- setup-depends: base >= 4.10 && < 4.13,
+ setup-depends: base >= 4.10 && < 4.14,
hunk ./darcs.cabal 393
- build-depends: base >= 4.10 && < 4.13,
+ build-depends: base >= 4.10 && < 4.14,
hunk ./darcs.cabal 397
+ filtrable >= 0.1.3.0 && < 0.2,
hunk ./darcs.cabal 407
- haskeline >= 0.7.2 && < 0.8,
+ haskeline >= 0.8 && < 0.9,
hunk ./darcs.cabal 515
- base >= 4.10 && < 4.13
+ base >= 4.10 && < 4.14
hunk ./darcs.cabal 533
- base >= 4.10 && < 4.13,
+ base >= 4.10 && < 4.14,
hunk ./harness/Darcs/Test/HashedStorage.hs 350
- where run = do file <- readFile (floatPath "substub/substub/file")
- file2 <- readFile (floatPath "substub/substub/file2")
+ where run = do Just file <- readFile (floatPath "substub/substub/file")
+ Just file2 <- readFile (floatPath "substub/substub/file2")
hunk ./src/Darcs/Patch/Apply.hs 74
-effectOnPaths :: (Apply p, ApplyState p ~ Tree)
+effectOnPaths :: (MonadFail m, Apply p, ApplyState p ~ Tree)
hunk ./src/Darcs/Patch/Apply.hs 77
- -> [AnchoredPath]
-effectOnPaths p fps = fps' where
- (_, fps', _) = applyToPaths p Nothing fps
-
-applyToPaths :: (Apply p, ApplyState p ~ Tree)
+ -> m [AnchoredPath]
+effectOnPaths p = fmap (\ (_, fps, _) -> fps) . applyToPaths p Nothing
+
+applyToPaths :: (MonadFail m, Apply p, ApplyState p ~ Tree)
hunk ./src/Darcs/Patch/Apply.hs 84
- -> ([AnchoredPath], [AnchoredPath], [(AnchoredPath, AnchoredPath)])
+ -> m ([AnchoredPath], [AnchoredPath], [(AnchoredPath, AnchoredPath)])
hunk ./src/Darcs/Patch/Apply.hs 88
-applyToTree :: (Apply p, Monad m, ApplyState p ~ Tree)
+applyToTree :: (Apply p, MonadFail m, ApplyState p ~ Tree)
hunk ./src/Darcs/Patch/ApplyMonad.hs 43
-import Control.Monad.Identity( Identity )
hunk ./src/Darcs/Patch/ApplyMonad.hs 58
-instance Monad m => ApplyMonadTrans Tree m where
+instance MonadFail m => ApplyMonadTrans Tree m where
hunk ./src/Darcs/Patch/ApplyMonad.hs 65
-class Monad m => ApplyMonadTree m where
+class MonadFail m => ApplyMonadTree m where
hunk ./src/Darcs/Patch/ApplyMonad.hs 69
- mReadFilePS :: AnchoredPath -> m B.ByteString
+ mReadFilePS :: AnchoredPath -> m (Maybe B.ByteString)
hunk ./src/Darcs/Patch/ApplyMonad.hs 97
-instance Monad m => ApplyMonad Tree (TM.TreeMonad m) where
+instance MonadFail m => ApplyMonad Tree (TM.TreeMonad m) where
hunk ./src/Darcs/Patch/ApplyMonad.hs 104
-instance Monad m => ApplyMonadTree (TM.TreeMonad m) where
+instance MonadFail m => ApplyMonadTree (TM.TreeMonad m) where
hunk ./src/Darcs/Patch/ApplyMonad.hs 108
- mReadFilePS p = B.concat `fmap` BL.toChunks `fmap` TM.readFile p
- mModifyFilePS p j = do have <- TM.fileExists p
- x <- if have then B.concat `fmap` BL.toChunks `fmap` TM.readFile p
- else return B.empty
- TM.writeFile p . BL.fromChunks . (:[]) =<< j x
+ mReadFilePS p = fmap (B.concat . BL.toChunks) <$> TM.readFile p
+ mModifyFilePS p j =
+ TM.writeFile p . BL.fromChunks . (:[]) =<< j =<< fromMaybe B.empty <$> mReadFilePS p
hunk ./src/Darcs/Patch/ApplyMonad.hs 136
-withFileNames :: Maybe [OrigFileNameOf] -> [AnchoredPath] -> FilePathMonad a
- -> FilePathMonadState
-withFileNames mbofnos fps x = execState x ([], fps, ofnos) where
+withFileNames :: Monad m => Maybe [OrigFileNameOf] -> [AnchoredPath] -> StateT FilePathMonadState m a
+ -> m FilePathMonadState
+withFileNames mbofnos fps x = execStateT x ([], fps, ofnos) where
hunk ./src/Darcs/Patch/ApplyMonad.hs 141
-instance ApplyMonad Tree FilePathMonad where
- type ApplyMonadBase FilePathMonad = Identity
-
-
-instance ApplyMonadTree FilePathMonad where
+instance (MonadFail m, ApplyMonadTree (StateT s m)) => ApplyMonad Tree (StateT s m) where
+ type ApplyMonadBase (StateT s m) = m
+
+instance MonadFail m => ApplyMonadTree (StateT FilePathMonadState m) where
hunk ./src/Darcs/Patch/ApplyMonad.hs 163
-instance ApplyMonad Tree RestrictedApply where
- type ApplyMonadBase RestrictedApply = Identity
-
-instance ApplyMonadTree RestrictedApply where
+instance (MonadFail m) => ApplyMonadTree (StateT (M.Map AnchoredPath B.ByteString) m) where
hunk ./src/Darcs/Patch/Depends.hs 268
-unwrapOneTagged :: (Monad m) => PatchSet rt p wX wY -> m (PatchSet rt p wX wY)
+unwrapOneTagged :: (MonadFail m) => PatchSet rt p wX wY -> m (PatchSet rt p wX wY)
hunk ./src/Darcs/Patch/Index/Monad.hs 43
-newtype FileModMonad a = FMM (State (Set AnchoredPath, [PatchMod AnchoredPath]) a)
+newtype FileModMonadT m a = FMMT (StateT (Set AnchoredPath, [PatchMod AnchoredPath]) m a)
hunk ./src/Darcs/Patch/Index/Monad.hs 47
+ , MonadFail
hunk ./src/Darcs/Patch/Index/Monad.hs 51
-withPatchMods :: FileModMonad a
+withPatchMods :: Monad m => FileModMonadT m a
hunk ./src/Darcs/Patch/Index/Monad.hs 53
- -> (Set AnchoredPath, [PatchMod AnchoredPath])
-withPatchMods (FMM m) fps = second reverse $ execState m (fps,[])
+ -> m (Set AnchoredPath, [PatchMod AnchoredPath])
+withPatchMods (FMMT m) fps = second reverse <$> execStateT m (fps,[])
hunk ./src/Darcs/Patch/Index/Monad.hs 58
-instance ApplyMonad Tree FileModMonad where
- type ApplyMonadBase FileModMonad = FileModMonad
+instance MonadFail m => ApplyMonad Tree (FileModMonadT m) where
+ type ApplyMonadBase (FileModMonadT m) = FileModMonadT m
hunk ./src/Darcs/Patch/Index/Monad.hs 64
-instance ApplyMonadTree FileModMonad where
+instance MonadFail m => ApplyMonadTree (FileModMonadT m) where
hunk ./src/Darcs/Patch/Index/Monad.hs 97
-addMod :: PatchMod AnchoredPath -> FileModMonad ()
+addMod :: Monad m => PatchMod AnchoredPath -> FileModMonadT m ()
hunk ./src/Darcs/Patch/Index/Monad.hs 100
-addFile :: AnchoredPath -> FileModMonad ()
+addFile :: Monad m => AnchoredPath -> FileModMonadT m ()
hunk ./src/Darcs/Patch/Index/Monad.hs 103
-createFile :: AnchoredPath -> FileModMonad ()
+createFile :: Monad m => AnchoredPath -> FileModMonadT m ()
hunk ./src/Darcs/Patch/Index/Monad.hs 109
-createDir :: AnchoredPath -> FileModMonad ()
+createDir :: Monad m => AnchoredPath -> FileModMonadT m ()
hunk ./src/Darcs/Patch/Index/Monad.hs 115
-errorIfPresent :: AnchoredPath -> Bool -> FileModMonad ()
+errorIfPresent :: Monad m => AnchoredPath -> Bool -> FileModMonadT m ()
hunk ./src/Darcs/Patch/Index/Monad.hs 125
-remove :: AnchoredPath -> FileModMonad ()
+remove :: Monad m => AnchoredPath -> FileModMonadT m ()
hunk ./src/Darcs/Patch/Index/Monad.hs 128
-modifyFps :: (Set AnchoredPath -> Set AnchoredPath) -> FileModMonad ()
+modifyFps :: Monad m => (Set AnchoredPath -> Set AnchoredPath) -> FileModMonadT m ()
hunk ./src/Darcs/Patch/Index/Monad.hs 137
-applyToFileMods :: (Apply p, ApplyState p ~ Tree)
+applyToFileMods :: (MonadFail m, Apply p, ApplyState p ~ Tree)
hunk ./src/Darcs/Patch/Index/Monad.hs 140
- -> (Set AnchoredPath, [PatchMod AnchoredPath])
+ -> m (Set AnchoredPath, [PatchMod AnchoredPath])
hunk ./src/Darcs/Patch/Match.hs 696
-applyInvToMatcher :: (IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m)
+applyInvToMatcher :: (IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m, MonadFail m)
hunk ./src/Darcs/Patch/Match.hs 709
-applyNInv :: (IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m)
+applyNInv :: (IsRepoType rt, MatchableRP p, ApplyMonad (ApplyState p) m, MonadFail m)
hunk ./src/Darcs/Patch/PatchInfoAnd.hs 191
-hopefullyM :: Monad m => PatchInfoAndG rt p wA wB -> m (p wA wB)
+hopefullyM :: MonadFail m => PatchInfoAndG rt p wA wB -> m (p wA wB)
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 29
+import Control.Arrow
+import Control.Monad (guard)
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 52
- apply (FP f (Hunk l o n)) = mModifyFilePS f $ applyHunk f (l, o, n)
+ apply (FP f (Hunk l o n)) = mModifyFilePS f $ either error pure . applyHunk f (l, o, n)
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 56
- Nothing -> fail $ "replace patch to " ++ ap2fp f
+ Nothing -> error $ "replace patch to " ++ ap2fp f
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 62
- else fail $ "binary patch to " ++ ap2fp f
+ else error $ "binary patch to " ++ ap2fp f
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 71
- do x <- mReadFilePS f
- mRemoveFile f
- return $ if B.null x
- then Nothing
- else Just ("WARNING: Fixing removal of non-empty file "++ap2fp f,
- -- No need to coerce because the content
- -- removal patch has freely decided contexts
- FP f (Binary x B.empty) :>: FP f RmFile :>: NilFL )
+ mReadFilePS f <* mRemoveFile f <₪>>= \ x ->
+ ("WARNING: Fixing removal of non-empty file "++ap2fp f,
+ -- No need to coerce because the content
+ -- removal patch has freely decided contexts
+ FP f (Binary x B.empty) :>: FP f RmFile :>: NilFL) <$ (guard . not . B.null) x
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 97
- do x <- mReadFilePS f
- mModifyFilePS f (\_ -> return new)
- if x /= old
- then return $
- Just ("WARNING: Fixing binary patch to "++ap2fp f,
- FP f (Binary x new) :>: NilFL
- )
- else return Nothing
+ mReadFilePS f <* mModifyFilePS f (\_ -> pure new) <₪>>= \ x ->
+ ("WARNING: Fixing binary patch to "++ap2fp f,
+ FP f (Binary x new) :>: NilFL) <$ guard (x /= old)
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 102
+infix 1 <₪>>=
+(<₪>>=) :: (Monad m, Functor f) => f (m a) -> (a -> m b) -> f (m b)
+xm <₪>>= f = (>>= f) <$> xm
+
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 120
- hunkmod NilFL content = return content
- hunkmod (Hunk line old new:>:hs) content =
- applyHunk f (line, old, new) content >>= hunkmod hs
- hunkmod _ _ = error "impossible case"
+ hunkmod NilFL = pure
+ hunkmod (Hunk line old new:>:hs) =
+ applyHunk f (line, old, new) >>> error ||| hunkmod hs
+ hunkmod _ = error "impossible case"
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 126
-applyHunk :: Monad m
- => AnchoredPath
+applyHunk :: AnchoredPath
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 129
- -> m FileContents
-applyHunk f h fc =
- case applyHunkLines h fc of
- Right fc' -> return fc'
- Left msg ->
- fail $
- "### Error applying:\n" ++ renderHunk h ++
- "\n### to file " ++ ap2fp f ++ ":\n" ++ BC.unpack fc ++
- "### Reason: " ++ msg
+ -> Either String FileContents
+applyHunk f h fc = doMsg +++ id $ applyHunkLines h fc
hunk ./src/Darcs/Patch/Prim/V1/Apply.hs 133
+ doMsg = foldr (++) `flip`
+ [ "### Error applying:\n", renderHunk h
+ , "\n### to file ", ap2fp f, ":\n", BC.unpack fc
+ , "### Reason: "]
hunk ./src/Darcs/Patch/Prim/V1/Commute.hs 80
+
+instance MonadFail Perhaps where
hunk ./src/Darcs/Patch/Show.hs 33
-import Darcs.Patch.ApplyMonad ( ApplyMonad )
+import Darcs.Patch.ApplyMonad ( ApplyMonad(ApplyMonadBase) )
hunk ./src/Darcs/Patch/Show.hs 56
- showContextPatch :: (ApplyMonad (ApplyState p) m)
+ showContextPatch :: (ApplyMonad (ApplyState p) m, MonadFail (ApplyMonadBase m))
hunk ./src/Darcs/Patch/TouchesFiles.hs 17
-
+{-# LANGUAGE MonadComprehensions #-}
hunk ./src/Darcs/Patch/TouchesFiles.hs 45
- :: (Apply p, PatchInspect p, ApplyState p ~ Tree)
- => Bool -> [AnchoredPath] -> FL (LabelledPatch p) wX wY -> [Label]
-labelTouching _ _ NilFL = []
-labelTouching wantTouching fs (lp :>: lps) =
- case lookTouchOnlyEffect fs (unLabel lp) of
- (doesTouch, fs') ->
- let rest = labelTouching wantTouching fs' lps
- in (if doesTouch == wantTouching
- then (label lp :)
- else id)
- rest
+ :: (MonadFail m, Apply p, PatchInspect p, ApplyState p ~ Tree)
+ => Bool -> [AnchoredPath] -> FL (LabelledPatch p) wX wY -> m [Label]
+labelTouching _ _ NilFL = pure []
+labelTouching wantTouching fs (lp :>: lps) = do
+ (doesTouch, fs') <- lookTouchOnlyEffect fs (unLabel lp)
+ (if doesTouch == wantTouching
+ then (label lp :)
+ else id) <$> labelTouching wantTouching fs' lps
hunk ./src/Darcs/Patch/TouchesFiles.hs 55
- :: (Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
- => [AnchoredPath] -> PatchChoices p wX wY -> [Label]
+ :: (MonadFail m, Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
+ => [AnchoredPath] -> PatchChoices p wX wY -> m [Label]
hunk ./src/Darcs/Patch/TouchesFiles.hs 62
- :: (Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
- => Maybe [AnchoredPath] -> PatchChoices p wX wY -> PatchChoices p wX wY
-selectTouching Nothing pc = pc
-selectTouching (Just paths) pc = forceFirsts xs pc
- where
- xs =
- case getChoices pc of
- _ :> mc :> lc -> labelTouching True paths (mc +>+ lc)
+ :: (MonadFail m, Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
+ => Maybe [AnchoredPath] -> PatchChoices p wX wY -> m (PatchChoices p wX wY)
+selectTouching Nothing pc = pure pc
+selectTouching (Just paths) pc =
+ [forceFirsts xs pc
+ | xs <- case getChoices pc of
+ _ :> mc :> lc -> labelTouching True paths (mc +>+ lc)
+ ]
hunk ./src/Darcs/Patch/TouchesFiles.hs 72
- :: (Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
- => Maybe [AnchoredPath] -> PatchChoices p wX wY -> PatchChoices p wX wY
-deselectNotTouching Nothing pc = pc
-deselectNotTouching (Just paths) pc =
- forceLasts (labelNotTouchingFM paths pc) pc
+ :: (MonadFail m, Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
+ => Maybe [AnchoredPath] -> PatchChoices p wX wY -> m (PatchChoices p wX wY)
+deselectNotTouching = \ case
+ Nothing -> pure
+ Just paths -> fmap . flip forceLasts <*> labelNotTouchingFM paths
hunk ./src/Darcs/Patch/TouchesFiles.hs 79
- :: (Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
- => Maybe [AnchoredPath] -> PatchChoices p wX wY -> PatchChoices p wX wY
-selectNotTouching Nothing pc = pc
-selectNotTouching (Just paths) pc = forceFirsts (labelNotTouchingFM paths pc) pc
+ :: (MonadFail m, Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
+ => Maybe [AnchoredPath] -> PatchChoices p wX wY -> m (PatchChoices p wX wY)
+selectNotTouching = \ case
+ Nothing -> pure
+ Just paths -> fmap . flip forceFirsts <*> labelNotTouchingFM paths
hunk ./src/Darcs/Patch/TouchesFiles.hs 86
- :: (Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
- => Maybe [AnchoredPath] -> FL p wX wY -> Sealed (FL p wX)
-chooseTouching Nothing p = seal p
+ :: (MonadFail m, Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
+ => Maybe [AnchoredPath] -> FL p wX wY -> m (Sealed (FL p wX))
+chooseTouching Nothing p = pure (seal p)
hunk ./src/Darcs/Patch/TouchesFiles.hs 90
- case getChoices $ selectTouching paths $ patchChoices p of
- fc :> _ :> _ -> seal $ mapFL_FL unLabel fc
+ [seal $ mapFL_FL unLabel fc | fc :> _ :> _ <- fmap getChoices . selectTouching paths $ patchChoices p]
hunk ./src/Darcs/Patch/TouchesFiles.hs 93
- :: (Apply p, ApplyState p ~ Tree)
- => [AnchoredPath] -> p wX wY -> (Bool, [AnchoredPath])
-lookTouchOnlyEffect fs p = (wasTouched, fs')
- where
- (wasTouched, _, fs', _) = lookTouch Nothing fs p
+ :: (MonadFail m, Apply p, ApplyState p ~ Tree)
+ => [AnchoredPath] -> p wX wY -> m (Bool, [AnchoredPath])
+lookTouchOnlyEffect fs p =
+ [(wasTouched, fs') | (wasTouched, _, fs', _) <- lookTouch Nothing fs p]
hunk ./src/Darcs/Patch/TouchesFiles.hs 99
- :: (Apply p, ApplyState p ~ Tree)
+ :: (MonadFail m, Apply p, ApplyState p ~ Tree)
hunk ./src/Darcs/Patch/TouchesFiles.hs 103
- -> (Bool, [AnchoredPath], [AnchoredPath], [(AnchoredPath, AnchoredPath)])
-lookTouch renames fs p = (anyTouched, touchedFs, fs', renames')
- where
- touchedFs = nub . concatMap fsAffectedBy $ affected
- fsAffectedBy af = filter (affectedBy af) fs
- anyTouched = length touchedFs > 0
- affectedBy :: AnchoredPath -> AnchoredPath -> Bool
- touched `affectedBy` f =
- touched `isPrefix` f || f `isPrefix` touched
- (affected, fs', renames') = applyToPaths p renames fs
+ -> m (Bool, [AnchoredPath], [AnchoredPath], [(AnchoredPath, AnchoredPath)])
+lookTouch renames fs p =
+ [(anyTouched, touchedFs, fs', renames')
+ | (affected, fs', renames') <- applyToPaths p renames fs
+ , let touchedFs = nub . concatMap fsAffectedBy $ affected
+ fsAffectedBy af = filter (affectedBy af) fs
+ anyTouched = length touchedFs > 0
+ affectedBy :: AnchoredPath -> AnchoredPath -> Bool
+ touched `affectedBy` f =
+ touched `isPrefix` f || f `isPrefix` touched
+ ]
hunk ./src/Darcs/Patch/V1/Commute.hs 103
+
+instance MonadFail Perhaps where
hunk ./src/Darcs/Patch/Viewing.hs 49
- ApplyMonad (ApplyState p) m)
+ ApplyMonad (ApplyState p) m, MonadFail (ApplyMonadBase m))
hunk ./src/Darcs/Patch/Viewing.hs 82
- have <- mDoesFileExist f
- content <- if have then Just `fmap` mReadFilePS f else return Nothing
+ content <- mReadFilePS f
hunk ./src/Darcs/Patch/Viewing.hs 132
- showContextPatchInternal :: (ApplyMonad (ApplyState (FL p)) m)
+ showContextPatchInternal :: (ApplyMonad (ApplyState (FL p)) m, MonadFail (ApplyMonadBase m))
hunk ./src/Darcs/Repository/ApplyPatches.hs 62
- deriving (Functor, Applicative, Monad)
+ deriving (Functor, Applicative, Monad, MonadFail)
hunk ./src/Darcs/Repository/ApplyPatches.hs 108
-class (Functor m, Monad m) => TolerantMonad m where
+class (Functor m, MonadFail m) => TolerantMonad m where
hunk ./src/Darcs/Repository/ApplyPatches.hs 114
- deriving (Functor, Applicative, Monad)
+ deriving (Functor, Applicative, Monad, MonadFail)
hunk ./src/Darcs/Repository/ApplyPatches.hs 122
- deriving (Functor, Applicative, Monad)
+ deriving (Functor, Applicative, Monad, MonadFail)
hunk ./src/Darcs/Repository/ApplyPatches.hs 130
- deriving (Functor, Applicative, Monad, TolerantMonad)
+ deriving (Functor, Applicative, Monad, MonadFail, TolerantMonad)
hunk ./src/Darcs/Repository/Diff.hs 86
-treeDiff :: forall m w prim . (Monad m, Gap w, PrimPatch prim)
+treeDiff :: forall m w prim . (MonadFail m, Gap w, PrimPatch prim)
hunk ./src/Darcs/Repository/HashedIO.hs 140
- x <- mReadFilePS f
+ Just x <- mReadFilePS f
hunk ./src/Darcs/Repository/HashedIO.hs 144
-readFileObject :: AnchoredPath -> HashedIO B.ByteString
+readFileObject :: AnchoredPath -> HashedIO (Maybe B.ByteString)
hunk ./src/Darcs/Repository/HashedIO.hs 151
- case geta F file cwd of
- Nothing -> fail $ "file doesn't exist..." ++ ap2fp path
- Just h -> readhash h
+ readhash `traverse` geta F file cwd
hunk ./src/Darcs/Repository/PatchIndex.hs 2
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE PartialTypeSignatures #-}
hunk ./src/Darcs/Repository/PatchIndex.hs 44
-import Control.Monad.State.Strict ( evalState, execState, State, gets, modify )
+import Control.Monad.State.Strict ( StateT (..), State, evalState, evalStateT, execState, gets, modify )
hunk ./src/Darcs/Repository/PatchIndex.hs 50
-import Data.List ( group, mapAccumL, sort, nub, (\\) )
+import Data.List ( group, sort, nub, (\\) )
hunk ./src/Darcs/Repository/PatchIndex.hs 54
+import Data.Tuple ( swap )
hunk ./src/Darcs/Repository/PatchIndex.hs 312
-createPatchIndexDisk repository ps = do
+createPatchIndexDisk repository ps =
hunk ./src/Darcs/Repository/PatchIndex.hs 314
- createPatchIndexFrom repository $ patches2patchMods patches S.empty
+ in createPatchIndexFrom repository =<< patches2patchMods patches S.empty
hunk ./src/Darcs/Repository/PatchIndex.hs 317
-patches2patchMods :: (Apply p, PatchInspect p, ApplyState p ~ Tree)
- => [Sealed2 (PatchInfoAnd rt p)] -> Set AnchoredPath -> [(PatchId, [PatchMod AnchoredPath])]
-patches2patchMods patches fns = snd $ mapAccumL go fns patches
+patches2patchMods :: (MonadFail m, Apply p, PatchInspect p, ApplyState p ~ Tree)
+ => [Sealed2 (PatchInfoAnd rt p)] -> Set AnchoredPath -> m [(PatchId, [PatchMod AnchoredPath])]
+patches2patchMods = evalStateT . traverse go
hunk ./src/Darcs/Repository/PatchIndex.hs 321
- go filenames (Sealed2 p) = (filenames', (pid, pmods_effect ++ pmods_dup))
- where pid = makePatchID . info $ p
- (filenames', pmods_effect) = applyToFileMods p filenames
- -- applyToFileMods only returns patchmods that actually modify a file,
+ go (Sealed2 p) =
+ [(pid, pmods_effect ++ pmods_dup)
+ | let pid = makePatchID . info $ p
+ , pmods_effect <- StateT $ fmap swap . applyToFileMods p
+ , let -- applyToFileMods only returns patchmods that actually modify a file,
hunk ./src/Darcs/Repository/PatchIndex.hs 340
+ ]
hunk ./src/Darcs/Repository/PatchIndex.hs 396
- newpmods = patches2patchMods newpatches filenames
+ newpmods <- patches2patchMods newpatches filenames
hunk ./src/Darcs/Repository/Resolution.hs 35
+import Data.Foldable
hunk ./src/Darcs/Repository/Resolution.hs 40
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Cont
hunk ./src/Darcs/Repository/Resolution.hs 171
- sa <- applyToTree (invert p1) s1
- sm <- applyToTree pmerged s1
- s2 <- applyToTree p2 sa
- let nms = listConflictedFiles pmerged
- nas = effectOnPaths (invert (effect pmerged)) nms
- n1s = effectOnPaths p1 nas
- n2s = effectOnPaths p2 nas
- ns = zip4 (tofp nas) (tofp n1s) (tofp n2s) (tofp nms)
- tofp = map (anchorPath "")
- write_files tree fs = writePlainTree (Tree.filter (filterPaths fs) tree) "."
- in do
- former_dir <- getCurrentDirectory
- withTempDir "version1" $ \absd1 -> do
- let d1 = toFilePath absd1
- write_files s1 n1s
- setCurrentDirectory former_dir
- withTempDir "ancestor" $ \absda -> do
- let da = toFilePath absda
- write_files sa nas
- setCurrentDirectory former_dir
- withTempDir "merged" $ \absdm -> do
- let dm = toFilePath absdm
- write_files sm nms
- setCurrentDirectory former_dir
- withTempDir "cleanmerged" $ \absdc -> do
- let dc = toFilePath absdc
- cloneTree dm "."
- setCurrentDirectory former_dir
- withTempDir "version2" $ \absd2 -> do
- let d2 = toFilePath absd2
- write_files s2 n2s
- mapM_ (externallyResolveFile c wantGuiPause da d1 d2 dm) ns
- sc <- readPlainTree dc
- sfixed <- readPlainTree dm
- ftf <- filetypeFunction
- unFreeLeft `fmap` treeDiff diffa ftf sc sfixed
+ sa <- applyToTree (invert p1) s1
+ sm <- applyToTree pmerged s1
+ s2 <- applyToTree p2 sa
+ let nms = listConflictedFiles pmerged
+ nas <- effectOnPaths (invert (effect pmerged)) nms
+ n1s <- effectOnPaths p1 nas
+ n2s <- effectOnPaths p2 nas
+ let ns = zip4 (tofp nas) (tofp n1s) (tofp n2s) (tofp nms)
+ tofp = map (anchorPath "")
+ write_files tree fs = lift $ writePlainTree (Tree.filter (filterPaths fs) tree) "."
+ former_dir <- getCurrentDirectory
+ let restore_dir = lift $ setCurrentDirectory former_dir
+ evalContT $ do
+ absd1 <- ContT $ withTempDir "version1"
+ let d1 = toFilePath absd1
+ write_files s1 n1s
+ restore_dir
+ absda <- ContT $ withTempDir "ancestor"
+ let da = toFilePath absda
+ write_files sa nas
+ restore_dir
+ absdm <- ContT $ withTempDir "merged"
+ let dm = toFilePath absdm
+ write_files sm nms
+ restore_dir
+ absdc <- ContT $ withTempDir "cleanmerged"
+ let dc = toFilePath absdc
+ lift $ cloneTree dm "."
+ restore_dir
+ absd2 <- ContT $ withTempDir "version2"
+ let d2 = toFilePath absd2
+ write_files s2 n2s
+ for_ ns $ lift . externallyResolveFile c wantGuiPause da d1 d2 dm
+ sc <- lift $ readPlainTree dc
+ sfixed <- lift $ readPlainTree dm
+ ftf <- lift filetypeFunction
+ lift $ unFreeLeft <$> treeDiff diffa ftf sc sfixed
hunk ./src/Darcs/Repository/State.hs 153
- let paths' = paths `union` effectOnPaths pending paths
- restrictPaths :: FilterTree tree m => tree m -> tree m
+ paths' <- union paths <$> effectOnPaths pending paths
+ let restrictPaths :: FilterTree tree m => tree m -> tree m
hunk ./src/Darcs/UI/Commands/Annotate.hs 116
- let (_, [path'], _) =
+ (_, [path'], _) <-
hunk ./src/Darcs/UI/Commands/Convert/Export.hs 273
- when isfile $ do bits <- T.readFile file
+ when isfile $ do Just bits <- T.readFile file
hunk ./src/Darcs/UI/Commands/Log.hs 205
- let recFiles = effectOnPaths (invert unrec) <$> files
- filtered_changes p =
+ recFiles <- effectOnPaths (invert unrec) `traverse` files
+ let filtered_changes p =
hunk ./src/Darcs/UI/Commands/Log.hs 308
- return $ filterPatchesByNames maxCountFlag fs ps''
+ filterPatchesByNames maxCountFlag fs ps''
hunk ./src/Darcs/UI/Commands/Log.hs 334
- :: forall rt p.
+ :: forall rt p m .
hunk ./src/Darcs/UI/Commands/Log.hs 337
+ , MonadFail m
hunk ./src/Darcs/UI/Commands/Log.hs 342
- -> LogInfo (PatchInfoAnd rt p)
-filterPatchesByNames maxcount paths patches = removeNonRenames $
- evalState (filterPatchesByNamesM paths patches) (maxcount, initRenames) where
+ -> m (LogInfo (PatchInfoAnd rt p))
+filterPatchesByNames maxcount paths patches = removeNonRenames <$>
+ evalStateT (filterPatchesByNamesM paths patches) (maxcount, initRenames) where
hunk ./src/Darcs/UI/Commands/Log.hs 362
- case lookTouch (Just renames) fs (invert (mkInvertible p)) of
+ lookTouch (Just renames) fs (invert (mkInvertible p)) >>= \ case
hunk ./src/Darcs/UI/Commands/MarkConflicts.hs 170
- pre_pending_paths = fmap backward_renames existing_paths
+ pre_pending_paths <- traverse backward_renames existing_paths
hunk ./src/Darcs/UI/Commands/MarkConflicts.hs 182
- return $ chooseTouching (fromOnly pre_pending_paths) mangled_res
+ chooseTouching (fromOnly pre_pending_paths) mangled_res
hunk ./src/Darcs/UI/Commands/MarkConflicts.hs 197
- let post_pending_affected_paths = forward_renames <$> affected_paths
+ post_pending_affected_paths <- traverse forward_renames affected_paths
hunk ./src/Darcs/UI/Commands/Revert.hs 146
- let pre_changed_files = effectOnPaths (invert changes) <$> files
+ pre_changed_files <- effectOnPaths (invert changes) `traverse` files
hunk ./src/Darcs/UI/Commands/Revert.hs 148
- Sealed touching_changes <- return (chooseTouching pre_changed_files changes)
+ Sealed touching_changes <- chooseTouching pre_changed_files changes
hunk ./src/Darcs/UI/Commands/ShowContents.hs 26
+import Data.Filtrable
hunk ./src/Darcs/UI/Commands/ShowContents.hs 83
- let readContents = do
- okpaths <- filterM TM.fileExists paths
- forM okpaths $ \f -> (B.concat . BL.toChunks) `fmap` TM.readFile f
+ let readContents =
+ flip mapMaybeA paths $ (fmap . fmap) (B.concat . BL.toChunks) . TM.readFile
hunk ./src/Darcs/UI/Commands/WhatsNew.hs 310
- chooseTouching paths <$> unrecordedChanges diffing lfm lfr repo paths
+ chooseTouching paths =<< unrecordedChanges diffing lfm lfr repo paths
hunk ./src/Darcs/UI/SelectChanges.hs 19
+{-# OPTIONS_GHC -fno-max-relevant-binds #-}
hunk ./src/Darcs/UI/SelectChanges.hs 60
-import Control.Monad ( liftM, unless, when, (>=>) )
+import Control.Monad ( liftM, unless, when, (>=>), (<=<) )
hunk ./src/Darcs/UI/SelectChanges.hs 307
-runSelection ps PSC { matchCriterion = mc, .. } = do
+runSelection ps PSC { matchCriterion = mc, .. } =
hunk ./src/Darcs/UI/SelectChanges.hs 336
- selectChanges . filterNotTouching . filterUnwanted . patchChoices
+ selectChanges <=< filterNotTouching . filterUnwanted . patchChoices
hunk ./src/Darcs/Util/Printer.hs 225
-data Color = Blue | Red | Green | Cyan | Magenta
+data Color = Blue | Red | Green | Cyan | Magenta | Yellow
hunk ./src/Darcs/Util/Printer/Color.hs 286
+makeColor Yellow = makeColor' Yellow
hunk ./src/Darcs/Util/Printer/Color.hs 294
+setColor Yellow = "\x1B[33m" -- light magenta
hunk ./src/Darcs/Util/Tree/Monad.hs 13
+{-# LANGUAGE ConstrainedClassMethods #-}
hunk ./src/Darcs/Util/Tree/Monad.hs 66
- readFile :: AnchoredPath -> m BL.ByteString
+ readFile :: AnchoredPath -> m (Maybe BL.ByteString)
hunk ./src/Darcs/Util/Tree/Monad.hs 80
- rename :: AnchoredPath -> AnchoredPath -> m ()
+ rename :: MonadFail m => AnchoredPath -> AnchoredPath -> m ()
hunk ./src/Darcs/Util/Tree/Monad.hs 223
- let f = findFile t p'
- case f of
- Nothing -> fail $ "No such file " ++ show p'
- Just x -> lift (readBlob x)
+ (lift . readBlob) `traverse` findFile t p'
Context:
[inline getLogInfoCore but factor out matchRange and matchNonrange
Ben Franksen <ben.franksen at online.de>**20190922211938
Ignore-this: e590751e1258a27aeda00a8ebf702ddda8aef13d1f8526b0027a6f656e481009ba0cea67fb90f831
]
[resolve issue2635: build/install man page only if we build darcs executable
Ben Franksen <ben.franksen at online.de>**20190919172422
Ignore-this: fb807291855fd6f511cd19fd59660876e6152290f07a8c9db704fd13f9e341218552502dec26764f
]
[unify RebaseChange and RebaseSelect
Ben Franksen <ben.franksen at online.de>**20190919164038
Ignore-this: 1a68ed05992b8a9e72f6ebdc99fcf1268541a0fc1755aa0516252d9cf3575ac0296560d471a345dc
]
[RebaseFixup take a prim as type argument, not a RepoPatch
Ben Franksen <ben.franksen at online.de>**20190919164038
Ignore-this: 67c29ae73d63aa6c0347bb01cb3fb548d9509d6128757da3d5e55d6263d6c202f48822dd3586a036
]
[remove CommuteNoConflicts from RepoPatch
Ben Franksen <ben.franksen at online.de>**20190919164038
Ignore-this: b10430ecf5311cf6f9afe67281adf63c6370b2011c9d0e6eb94d807f72e47eed178c101f78570c60
]
[remove patch type parameter to RebaseName
Ben Franksen <ben.franksen at online.de>**20190919164038
Ignore-this: 630b06b6ccb86f21992daf8f6371e89636a18fef9832b607ba084d971491b97a36e3c7fa0cca671f
Also remove its Apply and PrimPatchBase instances.
]
[eliminate Invert instances for Named, WrappedNamed, and PatchInfoAnd
Ben Franksen <ben.franksen at online.de>**20190919164037
Ignore-this: 4e554c70104c989f300cb36a846c406caf384856c96d1012e3170b066c161f13c2bb6860c8265457
]
[replace CommuteNoConflicts with CleanMerge for prim patch types
Ben Franksen <ben.franksen at online.de>**20190919164037
Ignore-this: 797a05625580c7c277159ad6032779a61e7e3c80816b747ab4008d757d74d2b369656f19b9420aa0
As a logical consequence this moves the definition of mergeList from
D.P.CommuteNoConflicts to D.P.Merge. We also explicitly call error in
definitions of cleanMerge and merge if the patch type has an Ident instance
and we try to merge two identical patches, since this is an undefined
operation.
]
[use cleanMerge to implement partitionConflictingFL
Ben Franksen <ben.franksen at online.de>**20190919164037
Ignore-this: f96859e6e37f5045f95a66700d65ae01e1ec4fedea4eb40df58842d75f35e6be508a92822919dba4
In order to simplify this change, it no longer takes a commuter as argument
but only works with plain FLs. This necessitates an upstream change to
filterOutConflicts, which while (we're at it) now gets the repositoiry
argument first, like all similar functions.
]
[add class CleanMerge & make it super class of Merge
Ben Franksen <ben.franksen at online.de>**20190919164037
Ignore-this: 57e6cec77040c30342bfa0958009b7324dba5ffef0b7233d322d95ba303611777761da455ac8187d
This does not yet replace CommuteNoConflicts. Instead, instances for
CleanMerge are, for now, defined in terms of mergeNoConflicts.
]
[remove lots of redundant constraints
Ben Franksen <ben.franksen at online.de>**20190919164036
Ignore-this: e28236636e10b3110e59361106bdbeeba9c6f24d69af6e0ffdeec0f0afa2f23fa74fc335fc11245a
]
[remove reverse constructors from RebaseSelect and RebaseChange
Ben Franksen <ben.franksen at online.de>**20190919164036
Ignore-this: c789b18be7b8e30590578aa59909f34f64afdb9a1bc967108609940d0f680fa2d76363c90da1e9e0
]
[Invertible: allow showPatch etc of Rev patches
Ben Franksen <ben.franksen at online.de>**20190919164036
Ignore-this: 392d0f4a4e5222b76dc0c22d1ddcbb0d4ff4dad2de874164879a26532e2c3a77515554ab39dc9261
Instead of calling error for Rev patches, requiring that the calling code
first re-inverts the patch, we now do that ourselves. This means a Rev patch
is shown in exactly the same way as a Fwd patch. This removes the need for
reInvert in Darcs.UI.SelectPatches.
]
[possible fix for D.UI.SelectChanges.selected
Ben Franksen <ben.franksen at online.de>**20190919164036
Ignore-this: 9fc482a1070d243f41ab1d2bb5b764f71de9258e27d99bb40b85fff7b428a0a82fdcc33c8c19798e
This makes it actually do what the docs claim it does. I am not sure this is
the correct behavior, though. It also renames it to getSelected to make its
easier to see where it is used, since the word 'selected' appears in lots of
places in this module, but getSelected is used only in printSelected.
]
[use Invertible to generalize runSelection
Ben Franksen <ben.franksen at online.de>**20190919164036
Ignore-this: bfcc3d4ab562293cf8c7bc66a0d11e6f006920d1d2fd920377c97784686249928227adc7fbb77d45
The new runSelection no longer requires an Invert instance for the patches.
This is done by wrapping them internally with Invertible. We keep the old
function under the new name runInvertibleSelection so we can use it for
selecting prims, since these are naturally invertible and we cannot and will
not use Splitters with wrapped Invertible patches.
]
[use effect to avoid inversion of non-prims in externalResolution
Ben Franksen <ben.franksen at online.de>**20190919164036
Ignore-this: a9d4cfb8dcc3006d404465b0285503f1f75b1a0eac0c5b20ca0cf9924fa063d53b766163f4f86ed6
]
[use Invertible when calling lookTouch in log command
Ben Franksen <ben.franksen at online.de>**20190919164036
Ignore-this: 617804a94451acd6261c3a0ed6edc977d2d36c73c634547316909c6a5129480ea4a06e88d00fb717
We call lookTouch with the patches inverted. To get rid of the Invert
constraint, we wrap the patch as an Invertible patch.
]
[add Darcs.Patch.Invertible
Ben Franksen <ben.franksen at online.de>**20190919164026
Ignore-this: 40fd44bd46e5630779a3ecebc028a33c1147785ab56dff6d0b48bc2de34cfb75bfd817a7fdcb6b3b
This is a wrapper type to make an arbitrary patch type formally invertible.
We define only instances that will be needed to statisfy Invert constraints
that are currently required in the Repository and UI subsystem. Some of the
class methods defined for Invertible assume the patch is actually positive.
]
[add unapply method to class Apply
Ben Franksen <ben.franksen at online.de>**20190919164009
Ignore-this: 831f51055ca373b7d41be78e6c582dd68cf09d6c221a63a901417e8f8c4df7bdc5bda832dce6eea1
The idea here is to allow to "inverse apply" a patch without that patch
necessarily having an Invert instance.
]
[remove superclass Commute from class Merge
Ben Franksen <ben.franksen at online.de>**20190910100155
Ignore-this: 7e6a752b226cbe930df0519e7a8ab63e80a02dc539e44e04ccb54e426ff3ee4a85c4b27b19220019
]
[use showPatch ForStorage in V3 error messages
Ben Franksen <ben.franksen at online.de>**20190901200334
Ignore-this: bfe50cc9dddf0f58bd2256f84220419c7da06685d5e23e24b513e704ba1bb763e6c8ea92afdc52d2
]
[remove Invert constraint from Matchable and MatchableRP
Ben Franksen <ben.franksen at online.de>**20190830221922
Ignore-this: e87f1de33bae746920f91cd1fa065215918ea9ee74916ff4c4b7775e93d486ff7eed15c0464a8a1e
This means we need to add it to a a few function that actually require it.
We do this as a preparation for eventually removing Invert instances from
all the higher level patch types.
]
[cleanups in log command
Ben Franksen <ben.franksen at online.de>**20190912085841
Ignore-this: beb145f355e35b98ecfcc839d9ea393cf83142098ae47fb647d5df1ac43b7aa847031601e9cc0204
]
[remove bogus ReadPatch instances for RebaseSelect and RebaseChange
Ben Franksen <ben.franksen at online.de>**20190910081742
Ignore-this: 27d4e8c0d4886e4b4b1d4a031acf4c9b0f3cb395b33aaf1daea81a8d52bb35816f4cd3557663cbba
]
[rename repr to reInvert and fix its haddocks
Ben Franksen <ben.franksen at online.de>**20190830081513
Ignore-this: 60877d2cf753e7bce24bb1cccbbe92ffabd5483c532104bc1642366516c0b5df28844d87f582ab56
]
[matching a patch should be invariant under inversion
Ben Franksen <ben.franksen at online.de>**20190830080459
Ignore-this: a7321c90ead98c2d1dea84b7c2752a66c159531c2d4e2034406fdca5c2be9448b3285b846b3de41b
This adds a property (only in the haddocks) to D.P.Match.matchAPatch and
removes re-inversion of patches when we apply a match criterion from
D.UI.SelectChanges.
]
[re-export all imported classes (with members) from Darcs.Patch.RepoPatch
Ben Franksen <ben.franksen at online.de>**20190829163918
Ignore-this: 25f54fe286b4efb9ae5bfb5d74bf47d94c263d06f762a26bda820efb7f44b1374cc8796efadbaebc
]
[fix lazy reading of inventories for apply command
Ben Franksen <ben.franksen at online.de>**20190914180221
Ignore-this: cfae5beaaf8687f3184852a7cb681521c39183daeb1941f85462bfd1b325220103d9b159f74dafc7
This was broken by checking availability of patches to be applied in a
complicated and inefficient way, which as a side-effect reads all local
inventories in our history.
]
[rename D.P.Rebase.Container to D.P.Rebase.Suspended
Ganesh Sittampalam <ganesh at earth.li>**20190914153826
Ignore-this: 6d8e0781683f4d6b6f242a1aca3cdd0f
The module primarily contains the Suspended type and code
to manipulate it.
]
[rewrite Summary RebaseChange to avoid force-commute
Ganesh Sittampalam <ganesh at earth.li>**20190911134024
Ignore-this: 65e0c112000c4d3a1025ef3d211ed0e6
]
[re-write Darcs.Patch.Bundle using Darcs.Util.Parser
Ben Franksen <ben.franksen at online.de>**20190902202035
Ignore-this: 1c60e07d0a1752ff6ef1db0a27a975683b9f9f5241eef933e7b486a176fce4108c8a9c4ab3c53238
This does not delete any of the old code yet. It merely renames the old
parseBundle to parseBundleOld. The old code will be deleted in a later
patch. It also doesn't re-implement scanContextFile yet.
]
[fix interpretation of bundles as patchsets
Ben Franksen <ben.franksen at online.de>**20190901131900
Ignore-this: 58d5603379eb21531c461e8838782a6bc9a8fcca9a7904a0d6a8bec33c420b67be6ded7f12b27847
We previously created invalid patchsets when a tag was present in the
context of a bundle. This worked (sort of) due to laziness but only if we
actually have that tag in our repo. If we don't then this rather dirty hack
interprets the bundle in a wrong context, i.e. Origin. Depending on how
findCommonAndUncommon is implemented we either get immediate errors ("cannot
commute common patches") or it hangs indefinitely trying to perform huge
amounts of bugus commutes of patches that aren't in their rightful context.
The same bug is still present in scanContextFile.
]
[simplify instance Summary RebaseChange
Ganesh Sittampalam <ganesh at earth.li>**20190903140534
Ignore-this: a5f0306c4213dcd701fb993f54e92e84
I'm not sure why it was so complicated before. Perhaps
changeAsMerge was used elsewhere at some point.
Also removed the comment about resolveConflicts which
doesn't make much sense now.
]
[use StandaloneDeriving for some Show instances
Ganesh Sittampalam <ganesh at earth.li>**20190902221900
Ignore-this: 8ab9c2769f4f3b5610c0ab1413347605
This is possible in cases where all the directly included
patches are concrete types rather than type variables.
For example it works for
data Foo p wX wY where
Foo :: Named p wX wY -> Foo p wX wY
but not for
data Foo p wX wY where
Foo :: p wX wY -> Foo p wX wY
]
[reduce the Show1/Show2 boilerplate with DefaultSignatures
Ganesh Sittampalam <ganesh at earth.li>**20190902130857
Ignore-this: ef867619eda2321368d1a6b2d5763aab
]
[turn PrimPatch into a constraint synonym
Ben Franksen <ben.franksen at online.de>**20190829163003
Ignore-this: 47127bef77c142a41cf44ca6718902285224f089e8c325fd3873e10d9e5514942b3b4a30852ff04
]
[turn RepoPatch into a constraint synonym
Ben Franksen <ben.franksen at online.de>**20190829162443
Ignore-this: 3925585e444f26e1b238e5a0df41e6aad5e9983bcce38194d0f8eb5c4bd6398ebed934ce6e95ffec
This has a lot of advantages wrt maintenance and gets us rid of a few orphan
instances. Also included a few minor cleanups in Darcs.Patch.RepoPatch.
]
[introduce PrimWithName and make NamedPrim a type synonym
Ganesh Sittampalam <ganesh at earth.li>**20190827114448
Ignore-this: 934632425eaa3bc82e5769dbee7549a9
]
[Refactor the commute implementation for NamedPrims
Ganesh Sittampalam <ganesh at earth.li>**20190827113620
Ignore-this: b1aabe8d5b3340a8a65a636460710dd8
It now just relies on the Ident class instead of the internals.
This also distinguishes a case that ought to be an internal error,
but the unit tests seem to rely on it, so this is left as a
TODO for now.
]
[use Darcs.Util.Graph.components for RepoPatchV3
Ben Franksen <ben.franksen at online.de>**20190825211920
Ignore-this: a6991e94f26b09f302c3a51ea09171f8fa09c9c73caa3f701f752f00c76c8274761a2dd0bdbe3d86
This required a few refactors and the introduction of a new data type for
components. In particular, the ltmis algorithm needs to be adapted to
working with just a subset of the vertices of a graph.
]
[remove Darcs.Util.Graph.bk and some minor refactors
Ben Franksen <ben.franksen at online.de>**20190825123225
Ignore-this: b3e8e66874b3692e2f417ba3c877d9573b6fc8b39507b1d28aacd80a087cd35705c524039ac64731
]
[move functions to generate graphs from harness to library
Ben Franksen <ben.franksen at online.de>**20190825162321
Ignore-this: b31586463112c753be6a0112b555f7b7f848cc5c39470ede7701a94f2268d021c1000a45e0b093a5
]
[replace quickcheck with leancheck for testing Graph properties
Ben Franksen <ben.franksen at online.de>**20190825133104
Ignore-this: 6ef50b2fd5c131b28df5584f650b525b1e8ed1c5af17dc0a6c0ff4ecfb11022c3286e182fc8fffcd
Calculating graph properties scales very badly because the specifications
aren't optimised (naturally). Exhaustive testing with leancheck is a lot
more effective here because we avoid testing with (too) large graphs.
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
set it to 0x8000 which covers all graphs up to size 6.
]
[simplify and improve Darcs.Util.Graph.components
Ben Franksen <ben.franksen at online.de>**20190825162606
Ignore-this: ed2245de76947994d2a937643fb3d6c406968d7c31f779733504ed605eb15302c6dc1a3703427567
It wasn't incorrect (according to the spec) but it did not always return
vertices ordered and also did a bit too much work.
]
[add Darcs.Util.Graph.components with properties and tests
Ben Franksen <ben.franksen at online.de>**20190825123434
Ignore-this: 3d7e63f134e3528d7d1d64973bc32fb8bbd6d5ba174423d72cd2bc34e02251119394633179e0fa59
]
[Darcs.Util.Graph: add properties and test them
Ben Franksen <ben.franksen at online.de>**20190821104132
Ignore-this: 51c2f7127ec6bf9366b0afc8a5aee83e602505c16a12d9d69623369cff58365cccef73d31b3bd3b5
]
[Darcs.Util.Graph: add hadocks
Ben Franksen <ben.franksen at online.de>**20190821084048
Ignore-this: 7b7931bdd919da44e34ae60340f446783e1b5343dfe3aeca2b241d4b1ee25c7e514c35907bdc60ca
]
[Darcs.Util.Graph: make helper functions local to ltmis
Ben Franksen <ben.franksen at online.de>**20190821083917
Ignore-this: 7869236b4f6e283050b2195f54c2465091194278a9b32f210de5c6cb24b2a2f11b1f8b2a402084c6
]
[TAG 2.15.1
Ben Franksen <ben.franksen at online.de>**20190821065908
Ignore-this: 4e9190f24c0c02b97865896d38e42743f7276dc9a3b28e0fa2a90086da5d6734cae6224e1a3141b5
]
Patch bundle hash:
87efc2081730bc930b13045257eb43647105315f
----------
messages: 21681
nosy: strake888
status: needs-screening
title: resolve 2616: Unbreak with base-4.13 — `Mon
__________________________________
Darcs bug tracker <bugs at darcs.net>
<http://bugs.darcs.net/patch1951>
__________________________________
More information about the darcs-devel
mailing list