module Darcs.Patch.ApplyPatches ( applyPatches ) where import Darcs.Patch.Info ( displayPatchInfo ) import Darcs.Patch.ApplyMonad ( ApplyMonad(..) ) import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully, info ) import Darcs.Patch.Apply ( Apply(..) ) import Darcs.Patch.MonadProgress ( MonadProgress, ProgressAction(..), runProgressActions) import Darcs.Patch.Witnesses.Ordered ( FL(..), mapFL ) import Darcs.Util.Printer ( text, ($$) ) applyPatches :: (MonadProgress m, ApplyMonad (ApplyState p) m, Apply p) => FL (PatchInfoAnd rt p) wX wY -> m () applyPatches :: FL (PatchInfoAnd rt p) wX wY -> m () applyPatches ps :: FL (PatchInfoAnd rt p) wX wY ps = String -> [ProgressAction m ()] -> m () forall (m :: * -> *). MonadProgress m => String -> [ProgressAction m ()] -> m () runProgressActions "Applying patch" ((forall wW wZ. PatchInfoAnd rt p wW wZ -> ProgressAction m ()) -> FL (PatchInfoAnd rt p) wX wY -> [ProgressAction m ()] forall (a :: * -> * -> *) b wX wY. (forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b] mapFL forall wW wZ. PatchInfoAnd rt p wW wZ -> ProgressAction m () forall (p :: * -> * -> *) (m :: * -> *) (rt :: RepoType) wA wB. (Apply p, ApplyMonad (ApplyState p) m) => PatchInfoAnd rt p wA wB -> ProgressAction m () doApply FL (PatchInfoAnd rt p) wX wY ps) where doApply :: PatchInfoAnd rt p wA wB -> ProgressAction m () doApply hp :: PatchInfoAnd rt p wA wB hp = ProgressAction :: forall (m :: * -> *) a. m a -> Doc -> Doc -> ProgressAction m a ProgressAction { paAction :: m () paAction = WrappedNamed rt p wA wB -> m () forall (p :: * -> * -> *) (m :: * -> *) wX wY. (Apply p, ApplyMonad (ApplyState p) m) => p wX wY -> m () apply (PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB forall (rt :: RepoType) (p :: * -> * -> *) wA wB. PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB hopefully PatchInfoAnd rt p wA wB hp) , paMessage :: Doc paMessage = PatchInfo -> Doc displayPatchInfo (PatchInfoAnd rt p wA wB -> PatchInfo forall (rt :: RepoType) (p :: * -> * -> *) wA wB. PatchInfoAnd rt p wA wB -> PatchInfo info PatchInfoAnd rt p wA wB hp) , paOnError :: Doc paOnError = String -> Doc text "Unapplicable patch:" Doc -> Doc -> Doc $$ PatchInfo -> Doc displayPatchInfo (PatchInfoAnd rt p wA wB -> PatchInfo forall (rt :: RepoType) (p :: * -> * -> *) wA wB. PatchInfoAnd rt p wA wB -> PatchInfo info PatchInfoAnd rt p wA wB hp) }