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')