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

-- | Return the pristine tree up to the given 'PatchSetMatch'.
-- In the typical case where the match is closer to the end of the repo than
-- its beginning, this is (a lot) more efficient than applying the result of
-- 'getOnePatchset' to an empty tree.
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

-- | Return the patches up to the given 'PatchSetMatch'.
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)