module Darcs.Repository.Match
(
getRecordedUpToMatch
, getOnePatchset
) where
import Darcs.Prelude
import Darcs.Patch.Match
( rollbackToPatchSetMatch
, PatchSetMatch(..)
, getMatchingTag
, matchAPatchset
)
import Darcs.Patch.Bundle ( readContextFile )
import Darcs.Patch.ApplyMonad ( ApplyMonad(..) )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch ( RepoPatch, IsRepoType )
import Darcs.Patch.Set ( Origin, PatchSet(..), SealedPatchSet, patchSetDrop )
import Darcs.Repository.Flags
( WithWorkingDir (WithWorkingDir) )
import Darcs.Repository.ApplyPatches ( DefaultIO, runDefault )
import Darcs.Repository.InternalTypes ( Repository )
import Darcs.Repository.Hashed ( readRepo )
import Darcs.Repository.Pristine ( createPristineDirectoryTree )
import Darcs.Util.Tree ( Tree )
import Darcs.Util.Path ( toFilePath )
getRecordedUpToMatch :: (ApplyMonad (ApplyState p) DefaultIO, IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wR wU wT
-> PatchSetMatch
-> IO ()
getRecordedUpToMatch :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(ApplyMonad (ApplyState p) DefaultIO, IsRepoType rt, RepoPatch p,
ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> PatchSetMatch -> IO ()
getRecordedUpToMatch Repository rt p wR wU wT
r = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT
-> (PatchSet rt p Origin wR -> DefaultIO ()) -> IO ()
withRecordedMatch Repository rt p wR wU wT
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wX.
(ApplyMonad (ApplyState p) m, IsRepoType rt, MatchableRP p,
ApplyState p ~ Tree) =>
PatchSetMatch -> PatchSet rt p Origin wX -> m ()
rollbackToPatchSetMatch
getOnePatchset :: (IsRepoType rt, RepoPatch p)
=> Repository rt p wR wU wR
-> PatchSetMatch
-> IO (SealedPatchSet rt p Origin)
getOnePatchset :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wR
-> PatchSetMatch -> IO (SealedPatchSet rt p Origin)
getOnePatchset Repository rt p wR wU wR
repository PatchSetMatch
pm =
case PatchSetMatch
pm of
IndexMatch Int
n -> forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
patchSetDrop (Int
nforall a. Num a => a -> a -> a
-Int
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repository
PatchMatch Matcher
m -> forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset Matcher
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repository
TagMatch Matcher
m -> forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
getMatchingTag Matcher
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repository
ContextMatch AbsolutePath
path -> do
PatchSet rt p Origin wR
ref <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wR
repository
forall (p :: * -> * -> *) (rt :: RepoType) wX.
Commute p =>
PatchSet rt p Origin wX
-> FilePath -> IO (SealedPatchSet rt p Origin)
readContextFile PatchSet rt p Origin wR
ref (forall a. FilePathLike a => a -> FilePath
toFilePath AbsolutePath
path)
withRecordedMatch :: (IsRepoType rt, RepoPatch p)
=> Repository rt p wR wU wT
-> (PatchSet rt p Origin wR -> DefaultIO ())
-> IO ()
withRecordedMatch :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT
-> (PatchSet rt p Origin wR -> DefaultIO ()) -> IO ()
withRecordedMatch Repository rt p wR wU wT
r PatchSet rt p Origin wR -> DefaultIO ()
job
= do forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> FilePath -> WithWorkingDir -> IO ()
createPristineDirectoryTree Repository rt p wR wU wT
r FilePath
"." WithWorkingDir
WithWorkingDir
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wT
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. DefaultIO a -> IO a
runDefault forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSet rt p Origin wR -> DefaultIO ()
job