{-
Copyright (C) 2006 John Goerzen <jgoerzen@complete.org>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}{- |
Module : Data.Progress.Meter
Copyright : Copyright (C) 2006 John Goerzen
License : GNU GPL, version 2 or above
Maintainer : John Goerzen <jgoerzen@complete.org>
Stability : provisional
Portability: portable
Tool for maintaining a status bar, supporting multiple simultaneous tasks,
as a layer atop "Data.Progress.Tracker".
Written by John Goerzen, jgoerzen\@complete.org -}moduleData.Progress.Meter(-- * TypesProgressMeter,-- * Creation and ConfigurationsimpleNewMeter,newMeter,setComponents,addComponent,removeComponent,setWidth,-- * Rendering and OutputrenderMeter,displayMeter,clearMeter,writeMeterString,autoDisplayMeter,killAutoDisplayMeter)whereimportData.Progress.TrackerimportControl.ConcurrentimportControl.Monad(when)importData.String.Utils(join)importSystem.Time.Utils(renderSecs)importData.Quantity(renderNums,binaryOpts)importSystem.IOimportControl.Monad(filterM){- | The main data type for the progress meter. -}dataProgressMeterR=ProgressMeterR{masterP::Progress,-- ^ The master 'Progress' object for overall statuscomponents::[Progress],-- ^ Individual component statuseswidth::Int,-- ^ Width of the meterunit::String,-- ^ Units of displayrenderer::[Integer]->[String],-- ^ Function to render numbersautoDisplayers::[ThreadId]-- ^ Auto-updating display}typeProgressMeter=MVarProgressMeterR{- | Set up a new status bar using defaults:
* The given tracker
* Width 80
* Data.Quantity.renderNums binaryOpts 1
* Unit inticator @"B"@
-}simpleNewMeter::Progress->IOProgressMetersimpleNewMeterpt=newMeterpt"B"80(renderNumsbinaryOpts1){- | Set up a new status bar. -}newMeter::Progress-- ^ The top-level 'Progress'->String-- ^ Unit indicator string->Int-- ^ Width of the terminal -- usually 80->([Integer]->[String])-- ^ A function to render sizes->IOProgressMeternewMetertrackeruwrfunc=newMVar$ProgressMeterR{masterP=tracker,components=[],width=w,renderer=rfunc,autoDisplayers=[],unit=u}{- | Adjust the list of components of this 'ProgressMeter'. -}setComponents::ProgressMeter->[Progress]->IO()setComponentsmetercomponentlist=modifyMVar_meter(\m->return$m{components=componentlist}){- | Add a new component to the list of components. -}addComponent::ProgressMeter->Progress->IO()addComponentmetercomponent=modifyMVar_meter(\m->return$m{components=component:componentsm}){- | Remove a component by name. -}removeComponent::ProgressMeter->String->IO()removeComponentmetercomponentname=modifyMVar_meter$\m->donewc<-filterM(\x->withStatusx(\y->return$trackerNamey/=componentname))(componentsm)return$m{components=newc}{- | Adjusts the width of this 'ProgressMeter'. -}setWidth::ProgressMeter->Int->IO()setWidthmeterw=modifyMVar_meter(\m->return$m{width=w}){- | Like renderMeter, but prints it to the screen instead of returning it.
This function will output CR, then the meter.
Pass stdout as the handle for regular display to the screen. -}displayMeter::Handle->ProgressMeter->IO()displayMeterhr=withMVarr$\meter->dos<-renderMeterRmeterhPutStrh("\r"++s)hFlushh-- By placing this whole thing under withMVar, we can effectively-- lock the IO and prevent IO from stomping on each other.{- | Clears the meter -- outputs CR, spaces equal to the width - 1,
then another CR.
Pass stdout as the handle for regular display to the screen. -}clearMeter::Handle->ProgressMeter->IO()clearMeterhpm=withMVarpm$\m->dohPutStrh(clearmeterstrm)hFlushh{- | Clears the meter, writes the given string, then restores the meter.
The string is assumed to contain a trailing newline.
Pass stdout as the handle for regular display to the screen. -}writeMeterString::Handle->ProgressMeter->String->IO()writeMeterStringhpmmsg=withMVarpm$\meter->dos<-renderMeterRmeterhPutStrh(clearmeterstrmeter)hPutStrhmsghPutStrhshFlushhclearmeterstr::ProgressMeterR->Stringclearmeterstrm="\r"++replicate(widthm-1)' '++"\r"{- | Starts a thread that updates the meter every n seconds by calling
the specified function. Note: @displayMeter stdout@
is an ideal function here.
Save this threadID and use it later to call 'stopAutoDisplayMeter'.
-}autoDisplayMeter::ProgressMeter-- ^ The meter to display->Int-- ^ Update interval in seconds->(ProgressMeter->IO())-- ^ Function to display it->IOThreadId-- ^ Resulting thread idautoDisplayMeterpmdelaydisplayfunc=dothread<-forkIOworkerthreadmodifyMVar_pm(\p->return$p{autoDisplayers=thread:autoDisplayersp})returnthreadwhereworkerthread=dotid<-myThreadId-- Help fix a race condition so that the above-- modifyMVar can run before a check ever doesyieldlooptidlooptid=dodisplayfuncpmthreadDelay(delay*1000000)c<-doIContinuetidwhenc(looptid)doIContinuetid=withMVarpm$\p->iftid`elem`autoDisplayerspthenreturnTrueelsereturnFalse{- | Stops the specified meter from displaying.
You should probably call 'clearMeter' after a call to this. -}killAutoDisplayMeter::ProgressMeter->ThreadId->IO()killAutoDisplayMeterpmt=modifyMVar_pm(\p->return$p{autoDisplayers=filter(/=t)(autoDisplayersp)}){- | Render the current status. -}renderMeter::ProgressMeter->IOStringrenderMeterr=withMVarr$renderMeterRrenderMeterR::ProgressMeterR->IOStringrenderMeterRmeter=dooverallpct<-renderpct$masterPmetercompnnts<-mapM(rendercomponent$renderermeter)(componentsmeter)letcomponentstr=casejoin" "compnntsof[]->""x->x++" "rightpart<-renderoverall(renderermeter)(masterPmeter)letleftpart=overallpct++" "++componentstrletpadwidth=(widthmeter)-1-(lengthleftpart)-(lengthrightpart)ifpadwidth<1thenreturn$take(widthmeter-1)$leftpart++rightpartelsereturn$leftpart++replicatepadwidth' '++rightpartwhereu=unitmeterrenderpctpt=withStatusptrenderpctptsrenderpctptspts=if(totalUnitspts==0)thenreturn"0%"elsereturn$show(((completedUnitspts)*100)`div`(totalUnitspts))++"%"rendercomponent::([Integer]->[String])->Progress->IOStringrendercomponentrfuncpt=withStatuspt$\pts->dopct<-renderpctptsptsletrenders=rfunc[totalUnitspts,completedUnitspts]return$"["++trackerNamepts++" "++(renders!!1)++u++"/"++headrenders++u++" "++pct++"]"renderoverall::(ProgressStatusesa(IO[Char]))=>([Integer]->[[Char]])->a->IO[Char]renderoverallrfuncpt=withStatuspt$\pts->doetr<-getETRptsspeed<-getSpeedptsreturn$head(rfunc[floor(speed::Double)])++u++"/s "++renderSecsetr