1 -- Copyright (C) 2002-2005,2007 David Roundy
    2 --
    3 -- This program is free software; you can redistribute it and/or modify
    4 -- it under the terms of the GNU General Public License as published by
    5 -- the Free Software Foundation; either version 2, or (at your option)
    6 -- any later version.
    7 --
    8 -- This program is distributed in the hope that it will be useful,
    9 -- but WITHOUT ANY WARRANTY; without even the implied warranty of
   10 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   11 -- GNU General Public License for more details.
   12 --
   13 -- You should have received a copy of the GNU General Public License
   14 -- along with this program; see the file COPYING.  If not, write to
   15 -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   16 -- Boston, MA 02110-1301, USA.
   17 
   18 {-# OPTIONS_GHC -cpp #-}
   19 {-# LANGUAGE CPP #-}
   20 
   21 #include "gadts.h"
   22 
   23 module Darcs.Repository.ApplyPatches ( apply_patches, apply_patches_with_feedback ) where
   24 
   25 import Darcs.Patch ( Patchy, apply )
   26 import Darcs.Hopefully ( PatchInfoAnd, hopefully, info )
   27 import Darcs.Patch.Info ( human_friendly )
   28 import Darcs.Ordered ( FL(..), lengthFL, mapFL )
   29 import Darcs.Flags ( DarcsFlag )
   30 import Darcs.Utils ( putDocLnError )
   31 import Progress ( beginTedious, endTedious, tediousSize, finishedOneIO )
   32 import Printer ( text )
   33 
   34 apply_patches_with_feedback :: Patchy p => [DarcsFlag] -> String -> FL (PatchInfoAnd p) C(x y) -> IO ()
   35 apply_patches_with_feedback _ _ NilFL = return ()
   36 apply_patches_with_feedback opts k patches =
   37     do beginTedious k
   38        tediousSize k (lengthFL patches)
   39        sequence_ $ mapFL apply_cautiously patches
   40        endTedious k
   41     where apply_cautiously :: Patchy p => PatchInfoAnd p C(a b) -> IO ()
   42           apply_cautiously hp =
   43              do finishedOneIO k (show $ human_friendly $ info hp)
   44                 apply opts (hopefully hp) `catch` \e ->
   45                   do putDocLnError $ text "Unapplicable patch:"
   46                      putDocLnError $ human_friendly (info hp)
   47                      ioError e
   48 
   49 apply_patches :: Patchy p => [DarcsFlag] -> FL (PatchInfoAnd p) C(x y) -> IO ()
   50 apply_patches opts ps = apply_patches_with_feedback opts "Applying patch" ps