{-# OPTIONS_GHC -fno-warn-orphans #-}
module Darcs.Patch.V1.Apply () where

import Darcs.Prelude

import Darcs.Patch.Apply ( ApplyState, Apply, apply )
import Darcs.Patch.Prim ( PrimPatch, applyPrimFL )
import Darcs.Patch.Repair ( RepairToFL, applyAndTryToFixFL,
                            mapMaybeSnd )
import Darcs.Patch.Effect ( effect )

import Darcs.Patch.V1.Commute ()
import Darcs.Patch.V1.Core ( RepoPatchV1(..) )
import Darcs.Patch.Witnesses.Ordered ( mapFL_FL )


instance PrimPatch prim => Apply (RepoPatchV1 prim) where
    type ApplyState (RepoPatchV1 prim) = ApplyState prim
    apply :: RepoPatchV1 prim wX wY -> m ()
apply RepoPatchV1 prim wX wY
p = FL prim wX wY -> m ()
forall (prim :: * -> * -> *) (m :: * -> *) wX wY.
(PrimApply prim, ApplyMonad (ApplyState prim) m) =>
FL prim wX wY -> m ()
applyPrimFL (FL prim wX wY -> m ()) -> FL prim wX wY -> m ()
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wX wY -> FL (PrimOf (RepoPatchV1 prim)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect RepoPatchV1 prim wX wY
p

instance PrimPatch prim => RepairToFL (RepoPatchV1 prim) where
    applyAndTryToFixFL :: RepoPatchV1 prim wX wY
-> m (Maybe (String, FL (RepoPatchV1 prim) wX wY))
applyAndTryToFixFL (PP prim wX wY
x) = (FL prim wX wY -> FL (RepoPatchV1 prim) wX wY)
-> Maybe (String, FL prim wX wY)
-> Maybe (String, FL (RepoPatchV1 prim) wX wY)
forall a b c. (a -> b) -> Maybe (c, a) -> Maybe (c, b)
mapMaybeSnd ((forall wW wY. prim wW wY -> RepoPatchV1 prim wW wY)
-> FL prim wX wY -> FL (RepoPatchV1 prim) wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. prim wW wY -> RepoPatchV1 prim wW wY
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RepoPatchV1 prim wX wY
PP) (Maybe (String, FL prim wX wY)
 -> Maybe (String, FL (RepoPatchV1 prim) wX wY))
-> m (Maybe (String, FL prim wX wY))
-> m (Maybe (String, FL (RepoPatchV1 prim) wX wY))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` prim wX wY -> m (Maybe (String, FL prim wX wY))
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(RepairToFL p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m (Maybe (String, FL p wX wY))
applyAndTryToFixFL prim wX wY
x
    applyAndTryToFixFL RepoPatchV1 prim wX wY
x = do RepoPatchV1 prim wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply RepoPatchV1 prim wX wY
x; Maybe (String, FL (RepoPatchV1 prim) wX wY)
-> m (Maybe (String, FL (RepoPatchV1 prim) wX wY))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (String, FL (RepoPatchV1 prim) wX wY)
forall a. Maybe a
Nothing