module Darcs.Patch.Apply
(
Apply(..)
, applyToPaths
, applyToTree
, applyToState
, maybeApplyToTree
, effectOnPaths
) where
import Darcs.Prelude
import Control.Exception ( catch, IOException )
import Darcs.Util.Path ( AnchoredPath )
import Darcs.Util.Tree ( Tree )
import Darcs.Patch.ApplyMonad ( ApplyMonad(..), withFileNames, ApplyMonadTrans(..) )
import Darcs.Patch.Invert ( Invert(..) )
import Darcs.Patch.Witnesses.Ordered ( FL(..), RL(..) )
class Apply p where
type ApplyState p :: (* -> *) -> *
apply :: ApplyMonad (ApplyState p) m => p wX wY -> m ()
unapply :: ApplyMonad (ApplyState p) m => p wX wY -> m ()
default unapply :: (ApplyMonad (ApplyState p) m, Invert p) => p wX wY -> m ()
unapply = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert
instance Apply p => Apply (FL p) where
type ApplyState (FL p) = ApplyState p
apply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (FL p)) m =>
FL p wX wY -> m ()
apply FL p wX wY
NilFL = forall (m :: * -> *) a. Monad m => a -> m a
return ()
apply (p wX wY
p:>:FL p wY wY
ps) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply p wX wY
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply FL p wY wY
ps
unapply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (FL p)) m =>
FL p wX wY -> m ()
unapply FL p wX wY
NilFL = forall (m :: * -> *) a. Monad m => a -> m a
return ()
unapply (p wX wY
p:>:FL p wY wY
ps) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply FL p wY wY
ps forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply p wX wY
p
instance Apply p => Apply (RL p) where
type ApplyState (RL p) = ApplyState p
apply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (RL p)) m =>
RL p wX wY -> m ()
apply RL p wX wY
NilRL = forall (m :: * -> *) a. Monad m => a -> m a
return ()
apply (RL p wX wY
ps:<:p wY wY
p) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply RL p wX wY
ps forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply p wY wY
p
unapply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (RL p)) m =>
RL p wX wY -> m ()
unapply RL p wX wY
NilRL = forall (m :: * -> *) a. Monad m => a -> m a
return ()
unapply (RL p wX wY
ps:<:p wY wY
p) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply p wY wY
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply RL p wX wY
ps
effectOnPaths :: (Apply p, ApplyState p ~ Tree)
=> p wX wY
-> [AnchoredPath]
-> [AnchoredPath]
effectOnPaths :: forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [AnchoredPath] -> [AnchoredPath]
effectOnPaths p wX wY
p [AnchoredPath]
fps = [AnchoredPath]
fps' where
([AnchoredPath]
_, [AnchoredPath]
fps', [(AnchoredPath, AnchoredPath)]
_) = forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY
-> Maybe [(AnchoredPath, AnchoredPath)]
-> [AnchoredPath]
-> ([AnchoredPath], [AnchoredPath], [(AnchoredPath, AnchoredPath)])
applyToPaths p wX wY
p forall a. Maybe a
Nothing [AnchoredPath]
fps
applyToPaths :: (Apply p, ApplyState p ~ Tree)
=> p wX wY
-> Maybe [(AnchoredPath, AnchoredPath)]
-> [AnchoredPath]
-> ([AnchoredPath], [AnchoredPath], [(AnchoredPath, AnchoredPath)])
applyToPaths :: forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY
-> Maybe [(AnchoredPath, AnchoredPath)]
-> [AnchoredPath]
-> ([AnchoredPath], [AnchoredPath], [(AnchoredPath, AnchoredPath)])
applyToPaths p wX wY
pa Maybe [(AnchoredPath, AnchoredPath)]
ofpos [AnchoredPath]
fs = forall a.
Maybe [(AnchoredPath, AnchoredPath)]
-> [AnchoredPath]
-> FilePathMonad a
-> ([AnchoredPath], [AnchoredPath], [(AnchoredPath, AnchoredPath)])
withFileNames Maybe [(AnchoredPath, AnchoredPath)]
ofpos [AnchoredPath]
fs (forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply p wX wY
pa)
applyToTree :: (Apply p, Monad m, ApplyState p ~ Tree)
=> p wX wY
-> Tree m
-> m (Tree m)
applyToTree :: forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, Monad m, ApplyState p ~ Tree) =>
p wX wY -> Tree m -> m (Tree m)
applyToTree = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonadTrans (ApplyState p) m) =>
p wX wY -> ApplyState p m -> m (ApplyState p m)
applyToState
applyToState :: forall p m wX wY. (Apply p, ApplyMonadTrans (ApplyState p) m)
=> p wX wY
-> (ApplyState p) m
-> m ((ApplyState p) m)
applyToState :: forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonadTrans (ApplyState p) m) =>
p wX wY -> ApplyState p m -> m (ApplyState p m)
applyToState p wX wY
patch ApplyState p m
t = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (state :: (* -> *) -> *) (m :: * -> *) x.
ApplyMonadTrans state m =>
ApplyMonadOver state m x -> state m -> m (x, state m)
runApplyMonad (forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply p wX wY
patch) ApplyState p m
t
maybeApplyToTree :: (Apply p, ApplyState p ~ Tree) => p wX wY -> Tree IO
-> IO (Maybe (Tree IO))
maybeApplyToTree :: forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> Tree IO -> IO (Maybe (Tree IO))
maybeApplyToTree p wX wY
patch Tree IO
tree =
(forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, Monad m, ApplyState p ~ Tree) =>
p wX wY -> Tree m -> m (Tree m)
applyToTree p wX wY
patch Tree IO
tree) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOException
_ :: IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)