#include "gadts.h"
module Darcs.Patch.Apply ( Apply(..),
applyToFilepaths,
applyToTree,
applyToState,
)
where
import Prelude hiding ( catch, pi )
import Darcs.Witnesses.Ordered ( FL(..), RL(..) )
import Darcs.Patch.ApplyMonad ( ApplyMonad(..), withFilePaths, ApplyMonadTrans(..) )
import Darcs.Patch.FileName( fn2fp, fp2fn )
import Storage.Hashed.Tree( Tree )
import Storage.Hashed.Monad( virtualTreeMonad )
import Control.Monad ( MonadPlus )
class Apply p where
type ApplyState p :: (* -> *) -> *
apply :: ApplyMonad m (ApplyState p) => p C(x y) -> m ()
instance Apply p => Apply (FL p) where
type ApplyState (FL p) = ApplyState p
apply NilFL = return ()
apply (p:>:ps) = apply p >> apply ps
instance Apply p => Apply (RL p) where
type ApplyState (RL p) = ApplyState p
apply NilRL = return ()
apply (p:<:ps) = apply ps >> apply p
applyToFilepaths :: (Apply p, ApplyState p ~ Tree) => p C(x y) -> [FilePath] -> [FilePath]
applyToFilepaths pa fs = map fn2fp $ withFilePaths (map fp2fn fs) (apply pa)
applyToTree :: (Apply p, Functor m, Monad m, ApplyState p ~ Tree)
=> p C(x y) -> Tree m -> m (Tree m)
applyToTree patch t = snd `fmap` virtualTreeMonad (apply patch) t
applyToState :: forall p m C(x y). (Apply p, ApplyMonadTrans m (ApplyState p))
=> p C(x y) -> (ApplyState p) m -> m ((ApplyState p) m)
applyToState patch t = snd `fmap` runApplyMonad (apply patch) t