-- Copyright (C) 2002-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. {-# LANGUAGE CPP #-} #include "gadts.h" module Darcs.Patch.Apply ( Apply(..), applyToFilepaths, applyToTree, ) where import Prelude hiding ( catch, pi ) import Darcs.Witnesses.Ordered ( FL(..), RL(..) ) import Darcs.Patch.ApplyMonad ( ApplyMonad(..), withFilePaths ) import Darcs.Patch.FileName( fn2fp, fp2fn ) import Storage.Hashed.Tree( Tree ) import Storage.Hashed.Monad( virtualTreeMonad ) import Control.Monad ( MonadPlus ) class Apply p where apply :: ApplyMonad m => p C(x y) -> m () instance Apply p => Apply (FL p) where apply NilFL = return () apply (p:>:ps) = apply p >> apply ps instance Apply p => Apply (RL p) where apply NilRL = return () apply (p:<:ps) = apply ps >> apply p applyToFilepaths :: Apply p => p C(x y) -> [FilePath] -> [FilePath] applyToFilepaths pa fs = map fn2fp $ withFilePaths (map fp2fn fs) (apply pa) -- | Apply a patch to a 'Tree', yielding a new 'Tree'. applyToTree :: (Apply p, Functor m, MonadPlus m) => p C(x y) -> Tree m -> m (Tree m) applyToTree patch t = snd `fmap` virtualTreeMonad (apply patch) t