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 _ = Maybe Doc forall a. Maybe a Nothing -- |'Repair' and 'RepairToFL' deal with repairing old patches that were -- were written out due to bugs or that we no longer wish to support. -- 'Repair' is implemented by collections of patches (FL, Named, PatchInfoAnd) that -- might need repairing. class Repair p where applyAndTryToFix :: ApplyMonad (ApplyState p) m => p wX wY -> m (Maybe (String, p wX wY)) -- |'RepairToFL' is implemented by single patches that can be repaired (Prim, Patch, RepoPatchV2) -- There is a default so that patch types with no current legacy problems don't need to -- have an implementation. 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 p wX wY -> m () forall (p :: * -> * -> *) (m :: * -> *) wX wY. (Apply p, ApplyMonad (ApplyState p) m) => p wX wY -> m () apply p wX wY p; Maybe (String, FL p wX wY) -> m (Maybe (String, FL p wX wY)) forall (m :: * -> *) a. Monad m => a -> m a return Maybe (String, FL p wX wY) forall a. Maybe a Nothing mapMaybeSnd :: (a -> b) -> Maybe (c, a) -> Maybe (c, b) mapMaybeSnd :: (a -> b) -> Maybe (c, a) -> Maybe (c, b) mapMaybeSnd a -> b f (Just (c a,a b)) = (c, b) -> Maybe (c, b) forall a. a -> Maybe a Just (c a,a -> b f a b) mapMaybeSnd a -> b _ Maybe (c, a) Nothing = Maybe (c, b) forall a. Maybe a Nothing instance Check p => Check (FL p) where isInconsistent :: FL p wX wY -> Maybe Doc isInconsistent = [Doc] -> Maybe Doc forall a. [a] -> Maybe a listToMaybe ([Doc] -> Maybe Doc) -> (FL p wX wY -> [Doc]) -> FL p wX wY -> Maybe Doc forall b c a. (b -> c) -> (a -> b) -> a -> c . [Maybe Doc] -> [Doc] forall a. [Maybe a] -> [a] catMaybes ([Maybe Doc] -> [Doc]) -> (FL p wX wY -> [Maybe Doc]) -> FL p wX wY -> [Doc] forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall wW wZ. p wW wZ -> Maybe Doc) -> FL p wX wY -> [Maybe Doc] forall (a :: * -> * -> *) b wX wY. (forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b] mapFL forall wW wZ. p wW wZ -> Maybe Doc forall (p :: * -> * -> *) wX wY. Check p => p wX wY -> Maybe Doc isInconsistent instance Check p => Check (RL p) where isInconsistent :: RL p wX wY -> Maybe Doc isInconsistent = [Doc] -> Maybe Doc forall a. [a] -> Maybe a listToMaybe ([Doc] -> Maybe Doc) -> (RL p wX wY -> [Doc]) -> RL p wX wY -> Maybe Doc forall b c a. (b -> c) -> (a -> b) -> a -> c . [Maybe Doc] -> [Doc] forall a. [Maybe a] -> [a] catMaybes ([Maybe Doc] -> [Doc]) -> (RL p wX wY -> [Maybe Doc]) -> RL p wX wY -> [Doc] forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall wW wZ. p wW wZ -> Maybe Doc) -> RL p wX wY -> [Maybe Doc] forall (a :: * -> * -> *) b wX wY. (forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b] mapRL forall wW wZ. p wW wZ -> Maybe Doc forall (p :: * -> * -> *) wX wY. Check p => p wX wY -> Maybe Doc isInconsistent instance RepairToFL p => Repair (FL p) where applyAndTryToFix :: FL p wX wY -> m (Maybe (String, FL p wX wY)) applyAndTryToFix FL p wX wY NilFL = Maybe (String, FL p wX wY) -> m (Maybe (String, FL p wX wY)) forall (m :: * -> *) a. Monad m => a -> m a return Maybe (String, FL p wX wY) forall a. Maybe a Nothing applyAndTryToFix (p wX wY p:>:FL p wY wY ps) = do Maybe (String, FL p wX wY) mp <- p wX wY -> m (Maybe (String, FL p wX wY)) 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 <- FL p wY wY -> m (Maybe (String, FL p wY wY)) 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 Maybe (String, FL p wX wY) -> m (Maybe (String, FL p wX wY)) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe (String, FL p wX wY) -> m (Maybe (String, FL p wX wY))) -> Maybe (String, FL p wX wY) -> m (Maybe (String, FL p wX wY)) 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) -> Maybe (String, FL p wX wY) forall a. Maybe a Nothing (Just (String e,FL p wX wY p'),Maybe (String, FL p wY wY) Nothing) -> (String, FL p wX wY) -> Maybe (String, FL p wX wY) forall a. a -> Maybe a Just (String e,FL p wX wY p'FL p wX wY -> FL p wY wY -> FL p wX wY 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')) -> (String, FL p wX wY) -> Maybe (String, FL p wX wY) forall a. a -> Maybe a Just (String e,p wX wY pp wX wY -> FL p wY wY -> FL p wX wY forall (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')) -> (String, FL p wX wY) -> Maybe (String, FL p wX wY) forall a. a -> Maybe a Just ([String] -> String unlines [String e,String es], FL p wX wY p'FL p wX wY -> FL p wY wY -> FL p wX wY forall (a :: * -> * -> *) wX wY wZ. FL a wX wY -> FL a wY wZ -> FL a wX wZ +>+FL p wY wY ps')