module Darcs.Patch.Repair
( Repair(..), RepairToFL(..), mapMaybeSnd, Check(..) )
where
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.ApplyMonad ( ApplyMonad )
import Darcs.Witnesses.Ordered ( FL(..), RL(..), mapFL, mapRL, (+>+) )
import Printer ( Doc )
import Data.Maybe ( catMaybes, listToMaybe )
#include "gadts.h"
class Check p where
isInconsistent :: p C(x y) -> Maybe Doc
isInconsistent _ = Nothing
class Repair p where
applyAndTryToFix :: ApplyMonad m (ApplyState p) => p C(x y) -> m (Maybe (String, p C(x y)))
class Apply p => RepairToFL p where
applyAndTryToFixFL :: ApplyMonad m (ApplyState p) => p C(x y) -> m (Maybe (String, FL p C(x y)))
applyAndTryToFixFL p = do apply p; return Nothing
mapMaybeSnd :: (a -> b) -> Maybe (c, a) -> Maybe (c, b)
mapMaybeSnd f (Just (a,b)) = Just (a,f b)
mapMaybeSnd _ Nothing = Nothing
instance Check p => Check (FL p) where
isInconsistent = listToMaybe . catMaybes . mapFL isInconsistent
instance Check p => Check (RL p) where
isInconsistent = listToMaybe . catMaybes . mapRL isInconsistent
instance RepairToFL p => Repair (FL p) where
applyAndTryToFix NilFL = return Nothing
applyAndTryToFix (p:>:ps) = do mp <- applyAndTryToFixFL p
mps <- applyAndTryToFix ps
return $ case (mp,mps) of
(Nothing, Nothing) -> Nothing
(Just (e,p'),Nothing) -> Just (e,p'+>+ps)
(Nothing, Just (e,ps')) -> Just (e,p:>:ps')
(Just (e,p'), Just (es,ps')) ->
Just (unlines [e,es], p'+>+ps')