module Darcs.Patch.Repair
( Repair(..), RepairToFL(..), mapMaybeSnd, Check(..) )
where
import Darcs.Prelude
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.ApplyMonad ( ApplyMonad )
import Darcs.Patch.Witnesses.Ordered ( FL(..), RL(..), mapFL, mapRL, (+>+) )
import Darcs.Util.Printer ( Doc )
import Data.Maybe ( catMaybes, listToMaybe )
class Check p where
isInconsistent :: p wX wY -> Maybe Doc
isInconsistent p wX wY
_ = forall a. Maybe a
Nothing
class Repair p where
applyAndTryToFix :: ApplyMonad (ApplyState p) m => p wX wY -> m (Maybe (String, p wX wY))
class Apply p => RepairToFL p where
applyAndTryToFixFL :: ApplyMonad (ApplyState p) m
=> p wX wY -> m (Maybe (String, FL p wX wY))
applyAndTryToFixFL p wX wY
p = do forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply p wX wY
p; forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
mapMaybeSnd :: (a -> b) -> Maybe (c, a) -> Maybe (c, b)
mapMaybeSnd :: forall a b c. (a -> b) -> Maybe (c, a) -> Maybe (c, b)
mapMaybeSnd a -> b
f (Just (c
a,a
b)) = forall a. a -> Maybe a
Just (c
a,a -> b
f a
b)
mapMaybeSnd a -> b
_ Maybe (c, a)
Nothing = forall a. Maybe a
Nothing
instance Check p => Check (FL p) where
isInconsistent :: forall wX wY. FL p wX wY -> Maybe Doc
isInconsistent = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (p :: * -> * -> *) wX wY. Check p => p wX wY -> Maybe Doc
isInconsistent
instance Check p => Check (RL p) where
isInconsistent :: forall wX wY. RL p wX wY -> Maybe Doc
isInconsistent = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL forall (p :: * -> * -> *) wX wY. Check p => p wX wY -> Maybe Doc
isInconsistent
instance RepairToFL p => Repair (FL p) where
applyAndTryToFix :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (FL p)) m =>
FL p wX wY -> m (Maybe (String, FL p wX wY))
applyAndTryToFix FL p wX wY
NilFL = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
applyAndTryToFix (p wX wY
p:>:FL p wY wY
ps) = do Maybe (String, FL p wX wY)
mp <- forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(RepairToFL p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m (Maybe (String, FL p wX wY))
applyAndTryToFixFL p wX wY
p
Maybe (String, FL p wY wY)
mps <- forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Repair p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m (Maybe (String, p wX wY))
applyAndTryToFix FL p wY wY
ps
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (Maybe (String, FL p wX wY)
mp,Maybe (String, FL p wY wY)
mps) of
(Maybe (String, FL p wX wY)
Nothing, Maybe (String, FL p wY wY)
Nothing) -> forall a. Maybe a
Nothing
(Just (String
e,FL p wX wY
p'),Maybe (String, FL p wY wY)
Nothing) -> forall a. a -> Maybe a
Just (String
e,FL p wX wY
p'forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+FL p wY wY
ps)
(Maybe (String, FL p wX wY)
Nothing, Just (String
e,FL p wY wY
ps')) -> forall a. a -> Maybe a
Just (String
e,p wX wY
pforall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL p wY wY
ps')
(Just (String
e,FL p wX wY
p'), Just (String
es,FL p wY wY
ps')) ->
forall a. a -> Maybe a
Just ([String] -> String
unlines [String
e,String
es], FL p wX wY
p'forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+FL p wY wY
ps')