module Darcs.Repository.Match
(
getPristineUpToMatch
, getOnePatchset
) where
import Darcs.Prelude
import Darcs.Patch.Match
( rollbackToPatchSetMatch
, PatchSetMatch(..)
, getMatchingTag
, matchAPatchset
)
import Darcs.Patch.Bundle ( readContextFile )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch ( RepoPatch )
import Darcs.Patch.Set ( Origin, SealedPatchSet, patchSetDrop )
import Darcs.Repository.InternalTypes ( Repository )
import Darcs.Repository.Hashed ( readPatches )
import Darcs.Repository.Pristine ( readPristine )
import Darcs.Util.Tree ( Tree )
import Darcs.Util.Tree.Monad ( virtualTreeIO )
import Darcs.Util.Path ( toFilePath )
getPristineUpToMatch :: (RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wU wR
-> PatchSetMatch
-> IO (Tree IO)
getPristineUpToMatch :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSetMatch -> IO (Tree IO)
getPristineUpToMatch Repository rt p wU wR
r PatchSetMatch
psm = do
PatchSet p Origin wR
ps <- Repository rt p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository rt p wU wR
r
Tree IO
tree <- Repository rt p wU wR -> IO (Tree IO)
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO (Tree IO)
readPristine Repository rt p wU wR
r
((), Tree IO) -> Tree IO
forall a b. (a, b) -> b
snd (((), Tree IO) -> Tree IO) -> IO ((), Tree IO) -> IO (Tree IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeIO () -> Tree IO -> IO ((), Tree IO)
forall a. TreeIO a -> Tree IO -> IO (a, Tree IO)
virtualTreeIO (PatchSetMatch -> PatchSet p Origin wR -> TreeIO ()
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ApplyMonad (ApplyState p) m, MatchableRP p,
ApplyState p ~ Tree) =>
PatchSetMatch -> PatchSet p Origin wX -> m ()
rollbackToPatchSetMatch PatchSetMatch
psm PatchSet p Origin wR
ps) Tree IO
tree
getOnePatchset :: RepoPatch p
=> Repository rt p wU wR
-> PatchSetMatch
-> IO (SealedPatchSet p Origin)
getOnePatchset :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR
-> PatchSetMatch -> IO (SealedPatchSet p Origin)
getOnePatchset Repository rt p wU wR
repository PatchSetMatch
pm =
case PatchSetMatch
pm of
IndexMatch Int
n -> Int -> PatchSet p Origin wR -> SealedPatchSet p Origin
forall (p :: * -> * -> *) wStart wX.
Int -> PatchSet p wStart wX -> SealedPatchSet p wStart
patchSetDrop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (PatchSet p Origin wR -> SealedPatchSet p Origin)
-> IO (PatchSet p Origin wR) -> IO (SealedPatchSet p Origin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository rt p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository rt p wU wR
repository
PatchMatch Matcher
m -> Matcher -> PatchSet p Origin wR -> SealedPatchSet p Origin
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
matchAPatchset Matcher
m (PatchSet p Origin wR -> SealedPatchSet p Origin)
-> IO (PatchSet p Origin wR) -> IO (SealedPatchSet p Origin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository rt p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository rt p wU wR
repository
TagMatch Matcher
m -> Matcher -> PatchSet p Origin wR -> SealedPatchSet p Origin
forall (p :: * -> * -> *) wStart wX.
MatchableRP p =>
Matcher -> PatchSet p wStart wX -> SealedPatchSet p wStart
getMatchingTag Matcher
m (PatchSet p Origin wR -> SealedPatchSet p Origin)
-> IO (PatchSet p Origin wR) -> IO (SealedPatchSet p Origin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository rt p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository rt p wU wR
repository
ContextMatch AbsolutePath
path -> do
PatchSet p Origin wR
ref <- Repository rt p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository rt p wU wR
repository
PatchSet p Origin wR -> FilePath -> IO (SealedPatchSet p Origin)
forall (p :: * -> * -> *) wX.
Commute p =>
PatchSet p Origin wX -> FilePath -> IO (SealedPatchSet p Origin)
readContextFile PatchSet p Origin wR
ref (AbsolutePath -> FilePath
forall a. FilePathLike a => a -> FilePath
toFilePath AbsolutePath
path)