<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>src/Data/Progress/Meter.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>{-
<a name="line-2"></a>Copyright (C) 2006 John Goerzen <jgoerzen@complete.org>
<a name="line-3"></a>
<a name="line-4"></a>This program is free software; you can redistribute it and/or modify
<a name="line-5"></a>it under the terms of the GNU General Public License as published by
<a name="line-6"></a>the Free Software Foundation; either version 2 of the License, or
<a name="line-7"></a>(at your option) any later version.
<a name="line-8"></a>
<a name="line-9"></a>This program is distributed in the hope that it will be useful,
<a name="line-10"></a>but WITHOUT ANY WARRANTY; without even the implied warranty of
<a name="line-11"></a>MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
<a name="line-12"></a>GNU General Public License for more details.
<a name="line-13"></a>
<a name="line-14"></a>You should have received a copy of the GNU General Public License
<a name="line-15"></a>along with this program; if not, write to the Free Software
<a name="line-16"></a>Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
<a name="line-17"></a>-}</span>
<a name="line-18"></a>
<a name="line-19"></a><span class='hs-comment'>{- |
<a name="line-20"></a> Module : Data.Progress.Meter
<a name="line-21"></a> Copyright : Copyright (C) 2006 John Goerzen
<a name="line-22"></a> License : GNU GPL, version 2 or above
<a name="line-23"></a>
<a name="line-24"></a> Maintainer : John Goerzen <jgoerzen@complete.org>
<a name="line-25"></a> Stability : provisional
<a name="line-26"></a> Portability: portable
<a name="line-27"></a>
<a name="line-28"></a>Tool for maintaining a status bar, supporting multiple simultaneous tasks,
<a name="line-29"></a>as a layer atop "Data.Progress.Tracker".
<a name="line-30"></a>
<a name="line-31"></a>Written by John Goerzen, jgoerzen\@complete.org -}</span>
<a name="line-32"></a>
<a name="line-33"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Progress</span><span class='hs-varop'>.</span><span class='hs-conid'>Meter</span> <span class='hs-layout'>(</span><span class='hs-comment'>-- * Types</span>
<a name="line-34"></a> <span class='hs-conid'>ProgressMeter</span><span class='hs-layout'>,</span>
<a name="line-35"></a> <span class='hs-comment'>-- * Creation and Configuration</span>
<a name="line-36"></a> <span class='hs-varid'>simpleNewMeter</span><span class='hs-layout'>,</span>
<a name="line-37"></a> <span class='hs-varid'>newMeter</span><span class='hs-layout'>,</span>
<a name="line-38"></a> <span class='hs-varid'>setComponents</span><span class='hs-layout'>,</span>
<a name="line-39"></a> <span class='hs-varid'>addComponent</span><span class='hs-layout'>,</span>
<a name="line-40"></a> <span class='hs-varid'>removeComponent</span><span class='hs-layout'>,</span>
<a name="line-41"></a> <span class='hs-varid'>setWidth</span><span class='hs-layout'>,</span>
<a name="line-42"></a>
<a name="line-43"></a> <span class='hs-comment'>-- * Rendering and Output</span>
<a name="line-44"></a> <span class='hs-varid'>renderMeter</span><span class='hs-layout'>,</span>
<a name="line-45"></a> <span class='hs-varid'>displayMeter</span><span class='hs-layout'>,</span>
<a name="line-46"></a> <span class='hs-varid'>clearMeter</span><span class='hs-layout'>,</span>
<a name="line-47"></a> <span class='hs-varid'>writeMeterString</span><span class='hs-layout'>,</span>
<a name="line-48"></a> <span class='hs-varid'>autoDisplayMeter</span><span class='hs-layout'>,</span>
<a name="line-49"></a> <span class='hs-varid'>killAutoDisplayMeter</span>
<a name="line-50"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-51"></a>
<a name="line-52"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Progress</span><span class='hs-varop'>.</span><span class='hs-conid'>Tracker</span>
<a name="line-53"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Concurrent</span>
<a name="line-54"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span> <span class='hs-layout'>(</span><span class='hs-varid'>when</span><span class='hs-layout'>)</span>
<a name="line-55"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>String</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span> <span class='hs-layout'>(</span><span class='hs-varid'>join</span><span class='hs-layout'>)</span>
<a name="line-56"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>Time</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span> <span class='hs-layout'>(</span><span class='hs-varid'>renderSecs</span><span class='hs-layout'>)</span>
<a name="line-57"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Quantity</span> <span class='hs-layout'>(</span><span class='hs-varid'>renderNums</span><span class='hs-layout'>,</span> <span class='hs-varid'>binaryOpts</span><span class='hs-layout'>)</span>
<a name="line-58"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span>
<a name="line-59"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span> <span class='hs-layout'>(</span><span class='hs-varid'>filterM</span><span class='hs-layout'>)</span>
<a name="line-60"></a>
<a name="line-61"></a><a name="ProgressMeterR"></a><span class='hs-comment'>{- | The main data type for the progress meter. -}</span>
<a name="line-62"></a><a name="ProgressMeterR"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>ProgressMeterR</span> <span class='hs-keyglyph'>=</span>
<a name="line-63"></a> <span class='hs-conid'>ProgressMeterR</span> <span class='hs-layout'>{</span><span class='hs-varid'>masterP</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Progress</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- ^ The master 'Progress' object for overall status</span>
<a name="line-64"></a> <span class='hs-varid'>components</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Progress</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- ^ Individual component statuses</span>
<a name="line-65"></a> <span class='hs-varid'>width</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- ^ Width of the meter</span>
<a name="line-66"></a> <span class='hs-varid'>unit</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- ^ Units of display</span>
<a name="line-67"></a> <span class='hs-varid'>renderer</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Integer</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>String</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- ^ Function to render numbers</span>
<a name="line-68"></a> <span class='hs-varid'>autoDisplayers</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>ThreadId</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- ^ Auto-updating display</span>
<a name="line-69"></a> <span class='hs-layout'>}</span>
<a name="line-70"></a>
<a name="line-71"></a><a name="ProgressMeter"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>ProgressMeter</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MVar</span> <span class='hs-conid'>ProgressMeterR</span>
<a name="line-72"></a>
<a name="line-73"></a><a name="simpleNewMeter"></a><span class='hs-comment'>{- | Set up a new status bar using defaults:
<a name="line-74"></a>
<a name="line-75"></a>* The given tracker
<a name="line-76"></a>
<a name="line-77"></a>* Width 80
<a name="line-78"></a>
<a name="line-79"></a>* Data.Quantity.renderNums binaryOpts 1
<a name="line-80"></a>
<a name="line-81"></a>* Unit inticator @"B"@
<a name="line-82"></a>
<a name="line-83"></a>-}</span>
<a name="line-84"></a><span class='hs-definition'>simpleNewMeter</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Progress</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>ProgressMeter</span>
<a name="line-85"></a><span class='hs-definition'>simpleNewMeter</span> <span class='hs-varid'>pt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>newMeter</span> <span class='hs-varid'>pt</span> <span class='hs-str'>"B"</span> <span class='hs-num'>80</span> <span class='hs-layout'>(</span><span class='hs-varid'>renderNums</span> <span class='hs-varid'>binaryOpts</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span>
<a name="line-86"></a>
<a name="line-87"></a><a name="newMeter"></a><span class='hs-comment'>{- | Set up a new status bar. -}</span>
<a name="line-88"></a><span class='hs-definition'>newMeter</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Progress</span> <span class='hs-comment'>-- ^ The top-level 'Progress'</span>
<a name="line-89"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span> <span class='hs-comment'>-- ^ Unit indicator string</span>
<a name="line-90"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-comment'>-- ^ Width of the terminal -- usually 80</span>
<a name="line-91"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Integer</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>String</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span><span class='hs-comment'>-- ^ A function to render sizes</span>
<a name="line-92"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>ProgressMeter</span>
<a name="line-93"></a><span class='hs-definition'>newMeter</span> <span class='hs-varid'>tracker</span> <span class='hs-varid'>u</span> <span class='hs-varid'>w</span> <span class='hs-varid'>rfunc</span> <span class='hs-keyglyph'>=</span>
<a name="line-94"></a> <span class='hs-varid'>newMVar</span> <span class='hs-varop'>$</span> <span class='hs-conid'>ProgressMeterR</span> <span class='hs-layout'>{</span><span class='hs-varid'>masterP</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tracker</span><span class='hs-layout'>,</span> <span class='hs-varid'>components</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span>
<a name="line-95"></a> <span class='hs-varid'>width</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>w</span><span class='hs-layout'>,</span> <span class='hs-varid'>renderer</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rfunc</span><span class='hs-layout'>,</span> <span class='hs-varid'>autoDisplayers</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span>
<a name="line-96"></a> <span class='hs-varid'>unit</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>u</span><span class='hs-layout'>}</span>
<a name="line-97"></a>
<a name="line-98"></a><a name="setComponents"></a><span class='hs-comment'>{- | Adjust the list of components of this 'ProgressMeter'. -}</span>
<a name="line-99"></a><span class='hs-definition'>setComponents</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressMeter</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Progress</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-100"></a><span class='hs-definition'>setComponents</span> <span class='hs-varid'>meter</span> <span class='hs-varid'>componentlist</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>modifyMVar_</span> <span class='hs-varid'>meter</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>m</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>m</span> <span class='hs-layout'>{</span><span class='hs-varid'>components</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>componentlist</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-101"></a>
<a name="line-102"></a><a name="addComponent"></a><span class='hs-comment'>{- | Add a new component to the list of components. -}</span>
<a name="line-103"></a><span class='hs-definition'>addComponent</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressMeter</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Progress</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-104"></a><span class='hs-definition'>addComponent</span> <span class='hs-varid'>meter</span> <span class='hs-varid'>component</span> <span class='hs-keyglyph'>=</span>
<a name="line-105"></a> <span class='hs-varid'>modifyMVar_</span> <span class='hs-varid'>meter</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>m</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>m</span> <span class='hs-layout'>{</span><span class='hs-varid'>components</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>component</span> <span class='hs-conop'>:</span> <span class='hs-varid'>components</span> <span class='hs-varid'>m</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-106"></a>
<a name="line-107"></a><a name="removeComponent"></a><span class='hs-comment'>{- | Remove a component by name. -}</span>
<a name="line-108"></a><span class='hs-definition'>removeComponent</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressMeter</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-109"></a><span class='hs-definition'>removeComponent</span> <span class='hs-varid'>meter</span> <span class='hs-varid'>componentname</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>modifyMVar_</span> <span class='hs-varid'>meter</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>m</span> <span class='hs-keyglyph'>-></span>
<a name="line-110"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>newc</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>filterM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>withStatus</span> <span class='hs-varid'>x</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>y</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>trackerName</span> <span class='hs-varid'>y</span> <span class='hs-varop'>/=</span> <span class='hs-varid'>componentname</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-111"></a> <span class='hs-layout'>(</span><span class='hs-varid'>components</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span>
<a name="line-112"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>m</span> <span class='hs-layout'>{</span><span class='hs-varid'>components</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>newc</span><span class='hs-layout'>}</span>
<a name="line-113"></a>
<a name="line-114"></a><a name="setWidth"></a><span class='hs-comment'>{- | Adjusts the width of this 'ProgressMeter'. -}</span>
<a name="line-115"></a><span class='hs-definition'>setWidth</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressMeter</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-116"></a><span class='hs-definition'>setWidth</span> <span class='hs-varid'>meter</span> <span class='hs-varid'>w</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>modifyMVar_</span> <span class='hs-varid'>meter</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>m</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>m</span> <span class='hs-layout'>{</span><span class='hs-varid'>width</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>w</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-117"></a>
<a name="line-118"></a><a name="displayMeter"></a><span class='hs-comment'>{- | Like renderMeter, but prints it to the screen instead of returning it.
<a name="line-119"></a>
<a name="line-120"></a>This function will output CR, then the meter.
<a name="line-121"></a>
<a name="line-122"></a>Pass stdout as the handle for regular display to the screen. -}</span>
<a name="line-123"></a><span class='hs-definition'>displayMeter</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Handle</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ProgressMeter</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-124"></a><span class='hs-definition'>displayMeter</span> <span class='hs-varid'>h</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withMVar</span> <span class='hs-varid'>r</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>meter</span> <span class='hs-keyglyph'>-></span>
<a name="line-125"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>renderMeterR</span> <span class='hs-varid'>meter</span>
<a name="line-126"></a> <span class='hs-varid'>hPutStr</span> <span class='hs-varid'>h</span> <span class='hs-layout'>(</span><span class='hs-str'>"\r"</span> <span class='hs-varop'>++</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span>
<a name="line-127"></a> <span class='hs-varid'>hFlush</span> <span class='hs-varid'>h</span>
<a name="line-128"></a> <span class='hs-comment'>-- By placing this whole thing under withMVar, we can effectively</span>
<a name="line-129"></a> <span class='hs-comment'>-- lock the IO and prevent IO from stomping on each other.</span>
<a name="line-130"></a>
<a name="line-131"></a><a name="clearMeter"></a><span class='hs-comment'>{- | Clears the meter -- outputs CR, spaces equal to the width - 1,
<a name="line-132"></a>then another CR.
<a name="line-133"></a>
<a name="line-134"></a>Pass stdout as the handle for regular display to the screen. -}</span>
<a name="line-135"></a><span class='hs-definition'>clearMeter</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Handle</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ProgressMeter</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-136"></a><span class='hs-definition'>clearMeter</span> <span class='hs-varid'>h</span> <span class='hs-varid'>pm</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withMVar</span> <span class='hs-varid'>pm</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>m</span> <span class='hs-keyglyph'>-></span>
<a name="line-137"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>hPutStr</span> <span class='hs-varid'>h</span> <span class='hs-layout'>(</span><span class='hs-varid'>clearmeterstr</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span>
<a name="line-138"></a> <span class='hs-varid'>hFlush</span> <span class='hs-varid'>h</span>
<a name="line-139"></a>
<a name="line-140"></a><a name="writeMeterString"></a><span class='hs-comment'>{- | Clears the meter, writes the given string, then restores the meter.
<a name="line-141"></a>The string is assumed to contain a trailing newline.
<a name="line-142"></a>
<a name="line-143"></a>Pass stdout as the handle for regular display to the screen. -}</span>
<a name="line-144"></a><span class='hs-definition'>writeMeterString</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Handle</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ProgressMeter</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-145"></a><span class='hs-definition'>writeMeterString</span> <span class='hs-varid'>h</span> <span class='hs-varid'>pm</span> <span class='hs-varid'>msg</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withMVar</span> <span class='hs-varid'>pm</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>meter</span> <span class='hs-keyglyph'>-></span>
<a name="line-146"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>renderMeterR</span> <span class='hs-varid'>meter</span>
<a name="line-147"></a> <span class='hs-varid'>hPutStr</span> <span class='hs-varid'>h</span> <span class='hs-layout'>(</span><span class='hs-varid'>clearmeterstr</span> <span class='hs-varid'>meter</span><span class='hs-layout'>)</span>
<a name="line-148"></a> <span class='hs-varid'>hPutStr</span> <span class='hs-varid'>h</span> <span class='hs-varid'>msg</span>
<a name="line-149"></a> <span class='hs-varid'>hPutStr</span> <span class='hs-varid'>h</span> <span class='hs-varid'>s</span>
<a name="line-150"></a> <span class='hs-varid'>hFlush</span> <span class='hs-varid'>h</span>
<a name="line-151"></a>
<a name="line-152"></a><a name="clearmeterstr"></a><span class='hs-definition'>clearmeterstr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressMeterR</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>String</span>
<a name="line-153"></a><span class='hs-definition'>clearmeterstr</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=</span> <span class='hs-str'>"\r"</span> <span class='hs-varop'>++</span> <span class='hs-varid'>replicate</span> <span class='hs-layout'>(</span><span class='hs-varid'>width</span> <span class='hs-varid'>m</span> <span class='hs-comment'>-</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-chr'>' '</span> <span class='hs-varop'>++</span> <span class='hs-str'>"\r"</span>
<a name="line-154"></a>
<a name="line-155"></a><a name="autoDisplayMeter"></a><span class='hs-comment'>{- | Starts a thread that updates the meter every n seconds by calling
<a name="line-156"></a>the specified function. Note: @displayMeter stdout@
<a name="line-157"></a>is an ideal function here.
<a name="line-158"></a>
<a name="line-159"></a>Save this threadID and use it later to call 'stopAutoDisplayMeter'.
<a name="line-160"></a>-}</span>
<a name="line-161"></a><span class='hs-definition'>autoDisplayMeter</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressMeter</span> <span class='hs-comment'>-- ^ The meter to display</span>
<a name="line-162"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Int</span> <span class='hs-comment'>-- ^ Update interval in seconds</span>
<a name="line-163"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>ProgressMeter</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- ^ Function to display it</span>
<a name="line-164"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>ThreadId</span> <span class='hs-comment'>-- ^ Resulting thread id</span>
<a name="line-165"></a><span class='hs-definition'>autoDisplayMeter</span> <span class='hs-varid'>pm</span> <span class='hs-varid'>delay</span> <span class='hs-varid'>displayfunc</span> <span class='hs-keyglyph'>=</span>
<a name="line-166"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>thread</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>forkIO</span> <span class='hs-varid'>workerthread</span>
<a name="line-167"></a> <span class='hs-varid'>modifyMVar_</span> <span class='hs-varid'>pm</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>p</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>p</span> <span class='hs-layout'>{</span><span class='hs-varid'>autoDisplayers</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>thread</span> <span class='hs-conop'>:</span> <span class='hs-varid'>autoDisplayers</span> <span class='hs-varid'>p</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-168"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>thread</span>
<a name="line-169"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>workerthread</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>tid</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>myThreadId</span>
<a name="line-170"></a> <span class='hs-comment'>-- Help fix a race condition so that the above</span>
<a name="line-171"></a> <span class='hs-comment'>-- modifyMVar can run before a check ever does</span>
<a name="line-172"></a> <span class='hs-varid'>yield</span>
<a name="line-173"></a> <span class='hs-varid'>loop</span> <span class='hs-varid'>tid</span>
<a name="line-174"></a> <span class='hs-varid'>loop</span> <span class='hs-varid'>tid</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>displayfunc</span> <span class='hs-varid'>pm</span>
<a name="line-175"></a> <span class='hs-varid'>threadDelay</span> <span class='hs-layout'>(</span><span class='hs-varid'>delay</span> <span class='hs-varop'>*</span> <span class='hs-num'>1000000</span><span class='hs-layout'>)</span>
<a name="line-176"></a> <span class='hs-varid'>c</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>doIContinue</span> <span class='hs-varid'>tid</span>
<a name="line-177"></a> <span class='hs-varid'>when</span> <span class='hs-varid'>c</span> <span class='hs-layout'>(</span><span class='hs-varid'>loop</span> <span class='hs-varid'>tid</span><span class='hs-layout'>)</span>
<a name="line-178"></a> <span class='hs-varid'>doIContinue</span> <span class='hs-varid'>tid</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withMVar</span> <span class='hs-varid'>pm</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>p</span> <span class='hs-keyglyph'>-></span>
<a name="line-179"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>tid</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>autoDisplayers</span> <span class='hs-varid'>p</span>
<a name="line-180"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-conid'>True</span>
<a name="line-181"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-conid'>False</span>
<a name="line-182"></a>
<a name="line-183"></a><a name="killAutoDisplayMeter"></a><span class='hs-comment'>{- | Stops the specified meter from displaying.
<a name="line-184"></a>
<a name="line-185"></a>You should probably call 'clearMeter' after a call to this. -}</span>
<a name="line-186"></a><span class='hs-definition'>killAutoDisplayMeter</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressMeter</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ThreadId</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-187"></a><span class='hs-definition'>killAutoDisplayMeter</span> <span class='hs-varid'>pm</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'>=</span>
<a name="line-188"></a> <span class='hs-varid'>modifyMVar_</span> <span class='hs-varid'>pm</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>p</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>p</span> <span class='hs-layout'>{</span><span class='hs-varid'>autoDisplayers</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>filter</span> <span class='hs-layout'>(</span><span class='hs-varop'>/=</span> <span class='hs-varid'>t</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>autoDisplayers</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-189"></a>
<a name="line-190"></a><a name="renderMeter"></a><span class='hs-comment'>{- | Render the current status. -}</span>
<a name="line-191"></a><span class='hs-definition'>renderMeter</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressMeter</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>String</span>
<a name="line-192"></a><span class='hs-definition'>renderMeter</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withMVar</span> <span class='hs-varid'>r</span> <span class='hs-varop'>$</span> <span class='hs-varid'>renderMeterR</span>
<a name="line-193"></a>
<a name="line-194"></a><a name="renderMeterR"></a><span class='hs-definition'>renderMeterR</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressMeterR</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>String</span>
<a name="line-195"></a><span class='hs-definition'>renderMeterR</span> <span class='hs-varid'>meter</span> <span class='hs-keyglyph'>=</span>
<a name="line-196"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>overallpct</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>renderpct</span> <span class='hs-varop'>$</span> <span class='hs-varid'>masterP</span> <span class='hs-varid'>meter</span>
<a name="line-197"></a> <span class='hs-varid'>compnnts</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mapM</span> <span class='hs-layout'>(</span><span class='hs-varid'>rendercomponent</span> <span class='hs-varop'>$</span> <span class='hs-varid'>renderer</span> <span class='hs-varid'>meter</span><span class='hs-layout'>)</span>
<a name="line-198"></a> <span class='hs-layout'>(</span><span class='hs-varid'>components</span> <span class='hs-varid'>meter</span><span class='hs-layout'>)</span>
<a name="line-199"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>componentstr</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>join</span> <span class='hs-str'>" "</span> <span class='hs-varid'>compnnts</span> <span class='hs-keyword'>of</span>
<a name="line-200"></a> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>-></span> <span class='hs-str'>""</span>
<a name="line-201"></a> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>x</span> <span class='hs-varop'>++</span> <span class='hs-str'>" "</span>
<a name="line-202"></a> <span class='hs-varid'>rightpart</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>renderoverall</span> <span class='hs-layout'>(</span><span class='hs-varid'>renderer</span> <span class='hs-varid'>meter</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>masterP</span> <span class='hs-varid'>meter</span><span class='hs-layout'>)</span>
<a name="line-203"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>leftpart</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>overallpct</span> <span class='hs-varop'>++</span> <span class='hs-str'>" "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>componentstr</span>
<a name="line-204"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>padwidth</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>width</span> <span class='hs-varid'>meter</span><span class='hs-layout'>)</span> <span class='hs-comment'>-</span> <span class='hs-num'>1</span> <span class='hs-comment'>-</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>leftpart</span><span class='hs-layout'>)</span> <span class='hs-comment'>-</span> <span class='hs-layout'>(</span><span class='hs-varid'>length</span> <span class='hs-varid'>rightpart</span><span class='hs-layout'>)</span>
<a name="line-205"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>padwidth</span> <span class='hs-varop'><</span> <span class='hs-num'>1</span>
<a name="line-206"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>take</span> <span class='hs-layout'>(</span><span class='hs-varid'>width</span> <span class='hs-varid'>meter</span> <span class='hs-comment'>-</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>leftpart</span> <span class='hs-varop'>++</span> <span class='hs-varid'>rightpart</span>
<a name="line-207"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>leftpart</span> <span class='hs-varop'>++</span> <span class='hs-varid'>replicate</span> <span class='hs-varid'>padwidth</span> <span class='hs-chr'>' '</span> <span class='hs-varop'>++</span> <span class='hs-varid'>rightpart</span>
<a name="line-208"></a>
<a name="line-209"></a> <span class='hs-keyword'>where</span>
<a name="line-210"></a> <span class='hs-varid'>u</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unit</span> <span class='hs-varid'>meter</span>
<a name="line-211"></a> <span class='hs-varid'>renderpct</span> <span class='hs-varid'>pt</span> <span class='hs-keyglyph'>=</span>
<a name="line-212"></a> <span class='hs-varid'>withStatus</span> <span class='hs-varid'>pt</span> <span class='hs-varid'>renderpctpts</span>
<a name="line-213"></a> <span class='hs-varid'>renderpctpts</span> <span class='hs-varid'>pts</span> <span class='hs-keyglyph'>=</span>
<a name="line-214"></a> <span class='hs-keyword'>if</span> <span class='hs-layout'>(</span><span class='hs-varid'>totalUnits</span> <span class='hs-varid'>pts</span> <span class='hs-varop'>==</span> <span class='hs-num'>0</span><span class='hs-layout'>)</span>
<a name="line-215"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-str'>"0%"</span>
<a name="line-216"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>show</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>completedUnits</span> <span class='hs-varid'>pts</span><span class='hs-layout'>)</span> <span class='hs-varop'>*</span> <span class='hs-num'>100</span><span class='hs-layout'>)</span> <span class='hs-varop'>`div`</span> <span class='hs-layout'>(</span><span class='hs-varid'>totalUnits</span> <span class='hs-varid'>pts</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>++</span> <span class='hs-str'>"%"</span>
<a name="line-217"></a> <span class='hs-varid'>rendercomponent</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Integer</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>String</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Progress</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>String</span>
<a name="line-218"></a> <span class='hs-varid'>rendercomponent</span> <span class='hs-varid'>rfunc</span> <span class='hs-varid'>pt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withStatus</span> <span class='hs-varid'>pt</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>pts</span> <span class='hs-keyglyph'>-></span>
<a name="line-219"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>pct</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>renderpctpts</span> <span class='hs-varid'>pts</span>
<a name="line-220"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>renders</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>rfunc</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>totalUnits</span> <span class='hs-varid'>pts</span><span class='hs-layout'>,</span> <span class='hs-varid'>completedUnits</span> <span class='hs-varid'>pts</span><span class='hs-keyglyph'>]</span>
<a name="line-221"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-str'>"["</span> <span class='hs-varop'>++</span> <span class='hs-varid'>trackerName</span> <span class='hs-varid'>pts</span> <span class='hs-varop'>++</span> <span class='hs-str'>" "</span> <span class='hs-varop'>++</span>
<a name="line-222"></a> <span class='hs-layout'>(</span><span class='hs-varid'>renders</span> <span class='hs-varop'>!!</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-varop'>++</span> <span class='hs-varid'>u</span> <span class='hs-varop'>++</span> <span class='hs-str'>"/"</span> <span class='hs-varop'>++</span>
<a name="line-223"></a> <span class='hs-varid'>head</span> <span class='hs-varid'>renders</span> <span class='hs-varop'>++</span> <span class='hs-varid'>u</span> <span class='hs-varop'>++</span> <span class='hs-str'>" "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>pct</span> <span class='hs-varop'>++</span> <span class='hs-str'>"]"</span>
<a name="line-224"></a>
<a name="line-225"></a> <span class='hs-varid'>renderoverall</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>ProgressStatuses</span> <span class='hs-varid'>a</span> <span class='hs-layout'>(</span><span class='hs-conid'>IO</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Char</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Integer</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Char</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Char</span><span class='hs-keyglyph'>]</span>
<a name="line-226"></a> <span class='hs-varid'>renderoverall</span> <span class='hs-varid'>rfunc</span> <span class='hs-varid'>pt</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withStatus</span> <span class='hs-varid'>pt</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>pts</span> <span class='hs-keyglyph'>-></span>
<a name="line-227"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>etr</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getETR</span> <span class='hs-varid'>pts</span>
<a name="line-228"></a> <span class='hs-varid'>speed</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getSpeed</span> <span class='hs-varid'>pts</span>
<a name="line-229"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>head</span> <span class='hs-layout'>(</span><span class='hs-varid'>rfunc</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>floor</span> <span class='hs-layout'>(</span><span class='hs-varid'>speed</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Double</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-varop'>++</span> <span class='hs-varid'>u</span> <span class='hs-varop'>++</span>
<a name="line-230"></a> <span class='hs-str'>"/s "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>renderSecs</span> <span class='hs-varid'>etr</span>
<a name="line-231"></a>
<a name="line-232"></a>
</pre></body>
</html>
distrib
>
Fedora
>
14
>
x86_64
>
media
>
updates
>
by-pkgid
>
ec5844e219498f2057da8f8f3070d4a1
>
files
>
277
