-- Copyright (C) 2011 Ganesh Sittampalam -- -- Permission is hereby granted, free of charge, to any person -- obtaining a copy of this software and associated documentation -- files (the "Software"), to deal in the Software without -- restriction, including without limitation the rights to use, copy, -- modify, merge, publish, distribute, sublicense, and/or sell copies -- of the Software, and to permit persons to whom the Software is -- furnished to do so, subject to the following conditions: -- -- The above copyright notice and this permission notice shall be -- included in all copies or substantial portions of the Software. -- -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS -- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN -- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -- SOFTWARE. module Darcs.Patch.MonadProgress ( MonadProgress(..) , ProgressAction(..) , silentlyRunProgressActions ) where import Darcs.Prelude import Darcs.Util.Printer ( Doc ) import Darcs.Util.Printer.Color () -- for instance Show Doc import qualified Darcs.Util.Tree.Monad as TM -- |a monadic action, annotated with a progress message that could be printed out -- while running the action, and a message that could be printed out on error. -- Actually printing out these messages is optional to allow non-IO monads to -- just run the action. data ProgressAction m a = ProgressAction {ProgressAction m a -> m a paAction :: m a ,ProgressAction m a -> Doc paMessage :: Doc ,ProgressAction m a -> Doc paOnError :: Doc } class Monad m => MonadProgress m where -- |run a list of 'ProgressAction's. In some monads (typically IO-based ones), -- the progress and error messages will be used. In others they will be -- ignored and just the actions will be run. runProgressActions :: String -> [ProgressAction m ()] -> m () -- |run a list of 'ProgressAction's without any feedback messages silentlyRunProgressActions :: Monad m => String -> [ProgressAction m ()] -> m () silentlyRunProgressActions :: String -> [ProgressAction m ()] -> m () silentlyRunProgressActions String _ = (ProgressAction m () -> m ()) -> [ProgressAction m ()] -> m () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ ProgressAction m () -> m () forall (m :: * -> *) a. ProgressAction m a -> m a paAction instance (Monad m) => MonadProgress (TM.TreeMonad m) where runProgressActions :: String -> [ProgressAction (TreeMonad m) ()] -> TreeMonad m () runProgressActions = String -> [ProgressAction (TreeMonad m) ()] -> TreeMonad m () forall (m :: * -> *). Monad m => String -> [ProgressAction m ()] -> m () silentlyRunProgressActions