{-# LANGUAGE TypeSynonymInstances #-}-- 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.moduleDarcs.MonadProgress(MonadProgress(..),ProgressAction(..),silentlyRunProgressActions)whereimportProgress(beginTedious,endTedious,tediousSize,finishedOneIO)importPrinter(hPutDocLn,Doc)importDarcs.ColorPrinter()-- for instance Show DocimportSystem.IO(stderr)importqualifiedStorage.Hashed.MonadasHSM-- |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.dataProgressActionma=ProgressAction{paAction::ma,paMessage::Doc,paOnError::Doc}classMonadm=>MonadProgressmwhere-- |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->[ProgressActionm()]->m()instanceMonadProgressIOwhererunProgressActions_[]=return()runProgressActionswhatitems=dobeginTediouswhattediousSizewhat(lengthitems)mapM_goitemsendTediouswhatwheregoitem=dofinishedOneIOwhat(show$paMessageitem)paActionitem`catch`\e->dohPutDocLnstderr$paOnErroritemioErrore-- |run a list of 'ProgressAction's without any feedback messagessilentlyRunProgressActions::Monadm=>String->[ProgressActionm()]->m()silentlyRunProgressActions_=mapM_paActioninstance(Functorm,Monadm)=>MonadProgress(HSM.TreeMonadm)whererunProgressActions=silentlyRunProgressActions