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