--  Copyright (C) 2004-2005 David Roundy
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

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 )

-- | Create a new pristine and working tree in the current working directory,
-- corresponding to the state of the 'PatchSet' returned by 'getOnePatchSet'
-- for the same 'PatchSetMatch'.
getRecordedUpToMatch :: (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 -> PatchSetMatch -> IO ()
getRecordedUpToMatch Repository rt p wR wU wT
r = Repository rt p wR wU wT
-> (PatchSet rt p Origin wR -> DefaultIO ()) -> IO ()
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 ()) -> IO ())
-> (PatchSetMatch -> PatchSet rt p Origin wR -> DefaultIO ())
-> PatchSetMatch
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSetMatch -> PatchSet rt p Origin wR -> DefaultIO ()
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 :: 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 -> Int -> PatchSet rt p Origin wR -> SealedPatchSet rt p Origin
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
Int -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
patchSetDrop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (PatchSet rt p Origin wR -> SealedPatchSet rt p Origin)
-> IO (PatchSet rt p Origin wR) -> IO (SealedPatchSet rt p Origin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
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 -> Matcher -> PatchSet rt p Origin wR -> SealedPatchSet rt p Origin
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
matchAPatchset Matcher
m (PatchSet rt p Origin wR -> SealedPatchSet rt p Origin)
-> IO (PatchSet rt p Origin wR) -> IO (SealedPatchSet rt p Origin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
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 -> Matcher -> PatchSet rt p Origin wR -> SealedPatchSet rt p Origin
forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
MatchableRP p =>
Matcher -> PatchSet rt p wStart wX -> SealedPatchSet rt p wStart
getMatchingTag Matcher
m (PatchSet rt p Origin wR -> SealedPatchSet rt p Origin)
-> IO (PatchSet rt p Origin wR) -> IO (SealedPatchSet rt p Origin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
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 <- Repository rt p wR wU wR -> IO (PatchSet rt p Origin wR)
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
      PatchSet rt p Origin wR
-> FilePath -> IO (SealedPatchSet rt p Origin)
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 (AbsolutePath -> FilePath
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 :: 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 Repository rt p wR wU wT -> FilePath -> WithWorkingDir -> IO ()
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
         Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
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 IO (PatchSet rt p Origin wR)
-> (PatchSet rt p Origin wR -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DefaultIO () -> IO ()
forall a. DefaultIO a -> IO a
runDefault (DefaultIO () -> IO ())
-> (PatchSet rt p Origin wR -> DefaultIO ())
-> PatchSet rt p Origin wR
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchSet rt p Origin wR -> DefaultIO ()
job