<?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/Tracker.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.Tracker
<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>Tools for tracking the status of a long operation.
<a name="line-29"></a>
<a name="line-30"></a>Written by John Goerzen, jgoerzen\@complete.org
<a name="line-31"></a>
<a name="line-32"></a>See also "Data.Progress.Meter" -}</span>
<a name="line-33"></a>
<a name="line-34"></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'>Tracker</span> <span class='hs-layout'>(</span>
<a name="line-35"></a> <span class='hs-comment'>-- * Introduction</span>
<a name="line-36"></a> <span class='hs-comment'>-- $introduction</span>
<a name="line-37"></a> <span class='hs-comment'>-- ** Examples</span>
<a name="line-38"></a> <span class='hs-comment'>-- $examples</span>
<a name="line-39"></a> <span class='hs-comment'>-- * Creation and Options</span>
<a name="line-40"></a> <span class='hs-varid'>newProgress</span><span class='hs-layout'>,</span> <span class='hs-varid'>newProgress'</span><span class='hs-layout'>,</span>
<a name="line-41"></a> <span class='hs-varid'>addCallback</span><span class='hs-layout'>,</span> <span class='hs-varid'>addParent</span><span class='hs-layout'>,</span>
<a name="line-42"></a> <span class='hs-comment'>-- * Updating</span>
<a name="line-43"></a> <span class='hs-varid'>incrP</span><span class='hs-layout'>,</span> <span class='hs-varid'>incrP'</span><span class='hs-layout'>,</span> <span class='hs-varid'>setP</span><span class='hs-layout'>,</span> <span class='hs-varid'>setP'</span><span class='hs-layout'>,</span> <span class='hs-varid'>incrTotal</span><span class='hs-layout'>,</span>
<a name="line-44"></a> <span class='hs-varid'>setTotal</span><span class='hs-layout'>,</span> <span class='hs-varid'>finishP</span><span class='hs-layout'>,</span>
<a name="line-45"></a> <span class='hs-comment'>-- * Reading and Processing</span>
<a name="line-46"></a> <span class='hs-varid'>getSpeed</span><span class='hs-layout'>,</span>
<a name="line-47"></a> <span class='hs-varid'>withStatus</span><span class='hs-layout'>,</span>
<a name="line-48"></a> <span class='hs-varid'>getETR</span><span class='hs-layout'>,</span>
<a name="line-49"></a> <span class='hs-varid'>getETA</span><span class='hs-layout'>,</span>
<a name="line-50"></a> <span class='hs-comment'>-- * Types</span>
<a name="line-51"></a> <span class='hs-conid'>ProgressStatus</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-52"></a> <span class='hs-conid'>Progress</span><span class='hs-layout'>,</span> <span class='hs-conid'>ProgressTimeSource</span><span class='hs-layout'>,</span>
<a name="line-53"></a> <span class='hs-conid'>ProgressCallback</span><span class='hs-layout'>,</span>
<a name="line-54"></a> <span class='hs-conid'>ProgressStatuses</span><span class='hs-layout'>,</span>
<a name="line-55"></a> <span class='hs-comment'>-- * Utilities</span>
<a name="line-56"></a> <span class='hs-varid'>defaultTimeSource</span>
<a name="line-57"></a> <span class='hs-layout'>)</span>
<a name="line-58"></a>
<a name="line-59"></a><span class='hs-keyword'>where</span>
<a name="line-60"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Concurrent</span><span class='hs-varop'>.</span><span class='hs-conid'>MVar</span>
<a name="line-61"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>Time</span>
<a name="line-62"></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>
<a name="line-63"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Ratio</span>
<a name="line-64"></a>
<a name="line-65"></a><span class='hs-comment'>{- $introduction
<a name="line-66"></a>
<a name="line-67"></a>ProgressTracker is a module for tracking the progress on long-running
<a name="line-68"></a>operations. It can be thought of as the back end engine behind
<a name="line-69"></a>a status bar. ProgressTracker can do things such as track how far along
<a name="line-70"></a>a task is, provide an estimated time of completion, estimated time remaining,
<a name="line-71"></a>current speed, etc. It is designed to be as generic as possible; it can even
<a name="line-72"></a>base its speed calculations on something other than the system clock.
<a name="line-73"></a>
<a name="line-74"></a>ProgressTracker also supports a notion of a parent tracker. This is used when
<a name="line-75"></a>a large task is composed of several individual tasks which may also be
<a name="line-76"></a>long-running. Downloading many large files over the Internet is a common
<a name="line-77"></a>example of this.
<a name="line-78"></a>
<a name="line-79"></a>Any given ProgressTracker can be told about one or more parent trackers.
<a name="line-80"></a>When the child tracker's status is updated, the parent tracker's status is
<a name="line-81"></a>also updated in the same manner. Therefore, the progress on each individual
<a name="line-82"></a>component, as well as the overall progress, can all be kept in sync
<a name="line-83"></a>automatically.
<a name="line-84"></a>
<a name="line-85"></a>Finally, you can register callbacks. Callbacks are functions that are called
<a name="line-86"></a>whenever the status of a tracker changes. They'll be passed the old and new
<a name="line-87"></a>status and are intended to do things like update on-screen status displays.
<a name="line-88"></a>
<a name="line-89"></a>The cousin module 'Data.Progress.Meter' can be used to nicely render
<a name="line-90"></a>these trackers on a console.
<a name="line-91"></a>-}</span>
<a name="line-92"></a>
<a name="line-93"></a><span class='hs-comment'>{- $examples
<a name="line-94"></a>
<a name="line-95"></a>Here is an example use:
<a name="line-96"></a>
<a name="line-97"></a>>do prog <- newProgress "mytracker" 1024
<a name="line-98"></a>> incrP prog 10
<a name="line-99"></a>> getETR prog >>= print -- prints number of seconds remaining
<a name="line-100"></a>> incrP prog 500
<a name="line-101"></a>> finishP prog
<a name="line-102"></a>-}</span>
<a name="line-103"></a>
<a name="line-104"></a><span class='hs-comment'>----------------------------------------------------------------------</span>
<a name="line-105"></a><span class='hs-comment'>-- TYPES</span>
<a name="line-106"></a><span class='hs-comment'>----------------------------------------------------------------------</span>
<a name="line-107"></a>
<a name="line-108"></a><a name="ProgressTimeSource"></a><span class='hs-comment'>{- | A function that, when called, yields the current time.
<a name="line-109"></a>The default is 'defaultTimeSource'. -}</span>
<a name="line-110"></a><a name="ProgressTimeSource"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>ProgressTimeSource</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>Integer</span>
<a name="line-111"></a>
<a name="line-112"></a><a name="ProgressCallback"></a><span class='hs-comment'>{- | The type for a callback function for the progress tracker.
<a name="line-113"></a>When given at creation time to 'newProgress\'' or when added via 'addCallback',
<a name="line-114"></a>these functions get called every time the status of the tracker changes.
<a name="line-115"></a>
<a name="line-116"></a>This function is passed two 'ProgressStatus' records: the first
<a name="line-117"></a>reflects the status prior to the update, and the second reflects
<a name="line-118"></a>the status after the update.
<a name="line-119"></a>
<a name="line-120"></a>Please note that the owning 'Progress' object will be locked while the
<a name="line-121"></a>callback is running, so the callback will not be able to make changes to it. -}</span>
<a name="line-122"></a><a name="ProgressCallback"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>ProgressCallback</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ProgressStatus</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ProgressStatus</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-123"></a>
<a name="line-124"></a><a name="ProgressStatus"></a><span class='hs-comment'>{- | The main progress status record. -}</span>
<a name="line-125"></a><a name="ProgressStatus"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>ProgressStatus</span> <span class='hs-keyglyph'>=</span>
<a name="line-126"></a> <span class='hs-conid'>ProgressStatus</span> <span class='hs-layout'>{</span><span class='hs-varid'>completedUnits</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Integer</span><span class='hs-layout'>,</span>
<a name="line-127"></a> <span class='hs-varid'>totalUnits</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Integer</span><span class='hs-layout'>,</span>
<a name="line-128"></a> <span class='hs-varid'>startTime</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Integer</span><span class='hs-layout'>,</span>
<a name="line-129"></a> <span class='hs-varid'>trackerName</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- ^ An identifying string</span>
<a name="line-130"></a> <span class='hs-varid'>timeSource</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressTimeSource</span>
<a name="line-131"></a> <span class='hs-layout'>}</span>
<a name="line-132"></a>
<a name="line-133"></a><a name="ProgressRecord"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>ProgressRecord</span> <span class='hs-keyglyph'>=</span>
<a name="line-134"></a> <span class='hs-conid'>ProgressRecord</span> <span class='hs-layout'>{</span><span class='hs-varid'>parents</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>
<a name="line-135"></a> <span class='hs-varid'>callbacks</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>ProgressCallback</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span>
<a name="line-136"></a> <span class='hs-varid'>status</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressStatus</span><span class='hs-layout'>}</span>
<a name="line-137"></a>
<a name="line-138"></a><a name="Progress"></a><span class='hs-comment'>{- | The main Progress object. -}</span>
<a name="line-139"></a><a name="Progress"></a><span class='hs-keyword'>newtype</span> <span class='hs-conid'>Progress</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Progress</span> <span class='hs-layout'>(</span><span class='hs-conid'>MVar</span> <span class='hs-conid'>ProgressRecord</span><span class='hs-layout'>)</span>
<a name="line-140"></a>
<a name="line-141"></a><a name="ProgressStatuses"></a><span class='hs-keyword'>class</span> <span class='hs-conid'>ProgressStatuses</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-keyword'>where</span>
<a name="line-142"></a> <span class='hs-comment'>{- | Lets you examine the 'ProgressStatus' that is contained
<a name="line-143"></a> within a 'Progress' object. You can simply pass
<a name="line-144"></a> a 'Progress' object and a function to 'withStatus', and
<a name="line-145"></a> 'withStatus' will lock the 'Progress' object (blocking any
<a name="line-146"></a> modifications while you are reading it), then pass the object
<a name="line-147"></a> to your function. If you happen to already have a 'ProgressStatus'
<a name="line-148"></a> object, withStatus will also accept it and simply pass it unmodified
<a name="line-149"></a> to the function. -}</span>
<a name="line-150"></a> <span class='hs-varid'>withStatus</span> <span class='hs-keyglyph'>::</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>ProgressStatus</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>b</span>
<a name="line-151"></a>
<a name="line-152"></a><a name="ProgressRecords"></a><span class='hs-keyword'>class</span> <span class='hs-conid'>ProgressRecords</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-keyword'>where</span>
<a name="line-153"></a> <span class='hs-varid'>withRecord</span> <span class='hs-keyglyph'>::</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>ProgressRecord</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>b</span>
<a name="line-154"></a>
<a name="line-155"></a><span class='hs-comment'>{-
<a name="line-156"></a>instance ProgressStatuses ProgressRecord b where
<a name="line-157"></a> withStatus x func = func (status x)
<a name="line-158"></a>instance ProgressRecords ProgressRecord b where
<a name="line-159"></a> withRecord x func = func x
<a name="line-160"></a>-}</span>
<a name="line-161"></a>
<a name="line-162"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>ProgressStatuses</span> <span class='hs-conid'>Progress</span> <span class='hs-layout'>(</span><span class='hs-conid'>IO</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-163"></a> <span class='hs-varid'>withStatus</span> <span class='hs-layout'>(</span><span class='hs-conid'>Progress</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-varid'>func</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withMVar</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'>func</span> <span class='hs-layout'>(</span><span class='hs-varid'>status</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-164"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>ProgressRecords</span> <span class='hs-conid'>Progress</span> <span class='hs-layout'>(</span><span class='hs-conid'>IO</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-165"></a> <span class='hs-varid'>withRecord</span> <span class='hs-layout'>(</span><span class='hs-conid'>Progress</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-varid'>func</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withMVar</span> <span class='hs-varid'>x</span> <span class='hs-varid'>func</span>
<a name="line-166"></a>
<a name="line-167"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>ProgressStatuses</span> <span class='hs-conid'>ProgressStatus</span> <span class='hs-varid'>b</span> <span class='hs-keyword'>where</span>
<a name="line-168"></a> <span class='hs-varid'>withStatus</span> <span class='hs-varid'>x</span> <span class='hs-varid'>func</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>func</span> <span class='hs-varid'>x</span>
<a name="line-169"></a>
<a name="line-170"></a><span class='hs-comment'>----------------------------------------------------------------------</span>
<a name="line-171"></a><span class='hs-comment'>-- Creation</span>
<a name="line-172"></a><span class='hs-comment'>----------------------------------------------------------------------</span>
<a name="line-173"></a>
<a name="line-174"></a><a name="newProgress"></a><span class='hs-comment'>{- | Create a new 'Progress' object with the given name and number
<a name="line-175"></a>of total units initialized as given. The start time will be initialized
<a name="line-176"></a>with the current time at the present moment according to the system clock.
<a name="line-177"></a>The units completed will be set to 0, the time source will be set to the
<a name="line-178"></a>system clock, and the parents and callbacks will be empty.
<a name="line-179"></a>
<a name="line-180"></a>If you need more control, see 'newProgress\''.
<a name="line-181"></a>
<a name="line-182"></a>Example:
<a name="line-183"></a>
<a name="line-184"></a>> prog <- newProgress "mytracker" 1024
<a name="line-185"></a>
<a name="line-186"></a>-}</span>
<a name="line-187"></a><span class='hs-definition'>newProgress</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-comment'>-- ^ Name of this tracker</span>
<a name="line-188"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Integer</span> <span class='hs-comment'>-- ^ Total units expected</span>
<a name="line-189"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>Progress</span>
<a name="line-190"></a><span class='hs-definition'>newProgress</span> <span class='hs-varid'>name</span> <span class='hs-varid'>total</span> <span class='hs-keyglyph'>=</span>
<a name="line-191"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>defaultTimeSource</span>
<a name="line-192"></a> <span class='hs-varid'>newProgress'</span> <span class='hs-layout'>(</span><span class='hs-conid'>ProgressStatus</span> <span class='hs-layout'>{</span><span class='hs-varid'>completedUnits</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0</span><span class='hs-layout'>,</span> <span class='hs-varid'>totalUnits</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>total</span><span class='hs-layout'>,</span>
<a name="line-193"></a> <span class='hs-varid'>startTime</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>t</span><span class='hs-layout'>,</span> <span class='hs-varid'>trackerName</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>name</span><span class='hs-layout'>,</span>
<a name="line-194"></a> <span class='hs-varid'>timeSource</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>defaultTimeSource</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-195"></a> <span class='hs-conid'>[]</span>
<a name="line-196"></a>
<a name="line-197"></a><a name="newProgress'"></a><span class='hs-comment'>{- | Create a new 'Progress' object initialized with the given status and
<a name="line-198"></a>callbacks.
<a name="line-199"></a>No adjustment to the 'startTime' will be made. If you
<a name="line-200"></a>want to use the system clock, you can initialize 'startTime' with
<a name="line-201"></a>the return value of 'defaultTimeSource' and also pass 'defaultTimeSource'
<a name="line-202"></a>as the timing source. -}</span>
<a name="line-203"></a><span class='hs-definition'>newProgress'</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressStatus</span>
<a name="line-204"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>ProgressCallback</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>Progress</span>
<a name="line-205"></a><span class='hs-definition'>newProgress'</span> <span class='hs-varid'>news</span> <span class='hs-varid'>newcb</span> <span class='hs-keyglyph'>=</span>
<a name="line-206"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newMVar</span> <span class='hs-varop'>$</span> <span class='hs-conid'>ProgressRecord</span> <span class='hs-layout'>{</span><span class='hs-varid'>parents</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span>
<a name="line-207"></a> <span class='hs-varid'>callbacks</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>newcb</span><span class='hs-layout'>,</span> <span class='hs-varid'>status</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>news</span><span class='hs-layout'>}</span>
<a name="line-208"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Progress</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span>
<a name="line-209"></a>
<a name="line-210"></a><a name="addCallback"></a><span class='hs-comment'>{- | Adds an new callback to an existing 'Progress'. The callback will be
<a name="line-211"></a>called whenever the object's status is updated, except by the call to finishP.
<a name="line-212"></a>
<a name="line-213"></a>Please note that the Progress object will be locked while the callback is
<a name="line-214"></a>running, so the callback will not be able to make any modifications to it.
<a name="line-215"></a>-}</span>
<a name="line-216"></a><span class='hs-definition'>addCallback</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Progress</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ProgressCallback</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-217"></a><span class='hs-definition'>addCallback</span> <span class='hs-layout'>(</span><span class='hs-conid'>Progress</span> <span class='hs-varid'>mpo</span><span class='hs-layout'>)</span> <span class='hs-varid'>cb</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>modifyMVar_</span> <span class='hs-varid'>mpo</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>po</span> <span class='hs-keyglyph'>-></span>
<a name="line-218"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>po</span> <span class='hs-layout'>{</span><span class='hs-varid'>callbacks</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>cb</span> <span class='hs-conop'>:</span> <span class='hs-varid'>callbacks</span> <span class='hs-varid'>po</span><span class='hs-layout'>}</span>
<a name="line-219"></a>
<a name="line-220"></a><a name="addParent"></a><span class='hs-comment'>{- | Adds a new parent to an existing 'Progress'. The parent
<a name="line-221"></a>will automatically have its completed and total counters incremented
<a name="line-222"></a>by the value of those counters in the existing 'Progress'. -}</span>
<a name="line-223"></a><span class='hs-definition'>addParent</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Progress</span> <span class='hs-comment'>-- ^ The child object</span>
<a name="line-224"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Progress</span> <span class='hs-comment'>-- ^ The parent to add to this child</span>
<a name="line-225"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-226"></a><span class='hs-definition'>addParent</span> <span class='hs-layout'>(</span><span class='hs-conid'>Progress</span> <span class='hs-varid'>mcpo</span><span class='hs-layout'>)</span> <span class='hs-varid'>ppo</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>modifyMVar_</span> <span class='hs-varid'>mcpo</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>cpo</span> <span class='hs-keyglyph'>-></span>
<a name="line-227"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>incrP'</span> <span class='hs-varid'>ppo</span> <span class='hs-layout'>(</span><span class='hs-varid'>completedUnits</span> <span class='hs-varop'>.</span> <span class='hs-varid'>status</span> <span class='hs-varop'>$</span> <span class='hs-varid'>cpo</span><span class='hs-layout'>)</span>
<a name="line-228"></a> <span class='hs-varid'>incrTotal</span> <span class='hs-varid'>ppo</span> <span class='hs-layout'>(</span><span class='hs-varid'>totalUnits</span> <span class='hs-varop'>.</span> <span class='hs-varid'>status</span> <span class='hs-varop'>$</span> <span class='hs-varid'>cpo</span><span class='hs-layout'>)</span>
<a name="line-229"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>cpo</span> <span class='hs-layout'>{</span><span class='hs-varid'>parents</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ppo</span> <span class='hs-conop'>:</span> <span class='hs-varid'>parents</span> <span class='hs-varid'>cpo</span><span class='hs-layout'>}</span>
<a name="line-230"></a>
<a name="line-231"></a><a name="finishP"></a><span class='hs-comment'>{- | Call this when you are finished with the object. It is especially
<a name="line-232"></a>important to do this when parent objects are involved.
<a name="line-233"></a>
<a name="line-234"></a>This will simply set the totalUnits to the current completedUnits count,
<a name="line-235"></a>but will not call the callbacks. It will additionally propogate
<a name="line-236"></a>any adjustment in totalUnits to the parents, whose callbacks /will/ be
<a name="line-237"></a>called.
<a name="line-238"></a>
<a name="line-239"></a>This ensures that the total expected counts on the parent are always correct.
<a name="line-240"></a>Without doing this, if, say, a transfer ended earlier than expected, ETA
<a name="line-241"></a>values on the parent would be off since it would be expecting more data than
<a name="line-242"></a>actually arrived. -}</span>
<a name="line-243"></a><span class='hs-definition'>finishP</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-244"></a><span class='hs-definition'>finishP</span> <span class='hs-layout'>(</span><span class='hs-conid'>Progress</span> <span class='hs-varid'>mp</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-245"></a> <span class='hs-varid'>modifyMVar_</span> <span class='hs-varid'>mp</span> <span class='hs-varid'>modfunc</span>
<a name="line-246"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>modfunc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressRecord</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>ProgressRecord</span>
<a name="line-247"></a> <span class='hs-varid'>modfunc</span> <span class='hs-varid'>oldpr</span> <span class='hs-keyglyph'>=</span>
<a name="line-248"></a> <span class='hs-keyword'>do</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>adjustment</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>completedUnits</span> <span class='hs-varop'>.</span> <span class='hs-varid'>status</span> <span class='hs-varop'>$</span> <span class='hs-varid'>oldpr</span><span class='hs-layout'>)</span>
<a name="line-249"></a> <span class='hs-comment'>-</span> <span class='hs-layout'>(</span><span class='hs-varid'>totalUnits</span> <span class='hs-varop'>.</span> <span class='hs-varid'>status</span> <span class='hs-varop'>$</span> <span class='hs-varid'>oldpr</span><span class='hs-layout'>)</span>
<a name="line-250"></a> <span class='hs-varid'>callParents</span> <span class='hs-varid'>oldpr</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'>incrTotal</span> <span class='hs-varid'>x</span> <span class='hs-varid'>adjustment</span><span class='hs-layout'>)</span>
<a name="line-251"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>oldpr</span> <span class='hs-layout'>{</span><span class='hs-varid'>status</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>status</span> <span class='hs-varid'>oldpr</span><span class='hs-layout'>)</span>
<a name="line-252"></a> <span class='hs-layout'>{</span><span class='hs-varid'>totalUnits</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>completedUnits</span> <span class='hs-varop'>.</span> <span class='hs-varid'>status</span> <span class='hs-varop'>$</span> <span class='hs-varid'>oldpr</span><span class='hs-layout'>}</span><span class='hs-layout'>}</span>
<a name="line-253"></a>
<a name="line-254"></a><a name="incrP"></a><span class='hs-comment'>----------------------------------------------------------------------</span>
<a name="line-255"></a><span class='hs-comment'>-- Updating</span>
<a name="line-256"></a><span class='hs-comment'>----------------------------------------------------------------------</span>
<a name="line-257"></a><span class='hs-comment'>{- | Increment the completed unit count in the 'Progress' object
<a name="line-258"></a>by the amount given. If the value as given exceeds the total, then
<a name="line-259"></a>the total will also be raised to match this value so that the
<a name="line-260"></a>completed count never exceeds the total.
<a name="line-261"></a>
<a name="line-262"></a>You can decrease the completed unit count by supplying a negative number
<a name="line-263"></a>here. -}</span>
<a name="line-264"></a><span class='hs-definition'>incrP</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Progress</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Integer</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-265"></a><span class='hs-definition'>incrP</span> <span class='hs-varid'>po</span> <span class='hs-varid'>count</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>modStatus</span> <span class='hs-varid'>po</span> <span class='hs-varid'>statusfunc</span>
<a name="line-266"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>statusfunc</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span>
<a name="line-267"></a> <span class='hs-varid'>s</span> <span class='hs-layout'>{</span><span class='hs-varid'>completedUnits</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>newcu</span> <span class='hs-varid'>s</span><span class='hs-layout'>,</span>
<a name="line-268"></a> <span class='hs-varid'>totalUnits</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>newcu</span> <span class='hs-varid'>s</span> <span class='hs-varop'>></span> <span class='hs-varid'>totalUnits</span> <span class='hs-varid'>s</span>
<a name="line-269"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>newcu</span> <span class='hs-varid'>s</span>
<a name="line-270"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>totalUnits</span> <span class='hs-varid'>s</span><span class='hs-layout'>}</span>
<a name="line-271"></a> <span class='hs-varid'>newcu</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>completedUnits</span> <span class='hs-varid'>s</span> <span class='hs-varop'>+</span> <span class='hs-varid'>count</span>
<a name="line-272"></a>
<a name="line-273"></a><a name="incrP'"></a><span class='hs-comment'>{- | Like 'incrP', but never modify the total. -}</span>
<a name="line-274"></a><span class='hs-definition'>incrP'</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Progress</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Integer</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-275"></a><span class='hs-definition'>incrP'</span> <span class='hs-varid'>po</span> <span class='hs-varid'>count</span> <span class='hs-keyglyph'>=</span>
<a name="line-276"></a> <span class='hs-varid'>modStatus</span> <span class='hs-varid'>po</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span> <span class='hs-layout'>{</span><span class='hs-varid'>completedUnits</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>completedUnits</span> <span class='hs-varid'>s</span> <span class='hs-varop'>+</span> <span class='hs-varid'>count</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-277"></a>
<a name="line-278"></a><a name="setP"></a><span class='hs-comment'>{- | Set the completed unit count in the 'Progress' object to the specified
<a name="line-279"></a>value. Unlike 'incrP', this function sets the count to a specific value,
<a name="line-280"></a>rather than adding to the existing value. If this value exceeds the total,
<a name="line-281"></a>then the total will also be raised to match this value so that the completed
<a name="line-282"></a>count never exceeds teh total. -}</span>
<a name="line-283"></a><span class='hs-definition'>setP</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Progress</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Integer</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-284"></a><span class='hs-definition'>setP</span> <span class='hs-varid'>po</span> <span class='hs-varid'>count</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>modStatus</span> <span class='hs-varid'>po</span> <span class='hs-varid'>statusfunc</span>
<a name="line-285"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>statusfunc</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span>
<a name="line-286"></a> <span class='hs-varid'>s</span> <span class='hs-layout'>{</span><span class='hs-varid'>completedUnits</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>count</span><span class='hs-layout'>,</span>
<a name="line-287"></a> <span class='hs-varid'>totalUnits</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>count</span> <span class='hs-varop'>></span> <span class='hs-varid'>totalUnits</span> <span class='hs-varid'>s</span>
<a name="line-288"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>count</span>
<a name="line-289"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>totalUnits</span> <span class='hs-varid'>s</span><span class='hs-layout'>}</span>
<a name="line-290"></a>
<a name="line-291"></a><a name="setP'"></a><span class='hs-comment'>{- | Like 'setP', but never modify the total. -}</span>
<a name="line-292"></a><span class='hs-definition'>setP'</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Progress</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Integer</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-293"></a><span class='hs-definition'>setP'</span> <span class='hs-varid'>po</span> <span class='hs-varid'>count</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>modStatus</span> <span class='hs-varid'>po</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span> <span class='hs-layout'>{</span><span class='hs-varid'>completedUnits</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>count</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-294"></a>
<a name="line-295"></a><a name="incrTotal"></a><span class='hs-comment'>{- | Increment the total unit count in the 'Progress' object by the amount
<a name="line-296"></a>given. This would rarely be needed, but could be needed in some special cases
<a name="line-297"></a>when the total number of units is not known in advance. -}</span>
<a name="line-298"></a><span class='hs-definition'>incrTotal</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Progress</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Integer</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-299"></a><span class='hs-definition'>incrTotal</span> <span class='hs-varid'>po</span> <span class='hs-varid'>count</span> <span class='hs-keyglyph'>=</span>
<a name="line-300"></a> <span class='hs-varid'>modStatus</span> <span class='hs-varid'>po</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span> <span class='hs-layout'>{</span><span class='hs-varid'>totalUnits</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>totalUnits</span> <span class='hs-varid'>s</span> <span class='hs-varop'>+</span> <span class='hs-varid'>count</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-301"></a>
<a name="line-302"></a><a name="setTotal"></a><span class='hs-comment'>{- | Set the total unit count in the 'Progress' object to the specified
<a name="line-303"></a>value. Like 'incrTotal', this would rarely be needed. -}</span>
<a name="line-304"></a><span class='hs-definition'>setTotal</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Progress</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Integer</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-305"></a><span class='hs-definition'>setTotal</span> <span class='hs-varid'>po</span> <span class='hs-varid'>count</span> <span class='hs-keyglyph'>=</span>
<a name="line-306"></a> <span class='hs-varid'>modStatus</span> <span class='hs-varid'>po</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span> <span class='hs-layout'>{</span><span class='hs-varid'>totalUnits</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>count</span><span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-307"></a>
<a name="line-308"></a><span class='hs-comment'>----------------------------------------------------------------------</span>
<a name="line-309"></a><span class='hs-comment'>-- Reading and Processing</span>
<a name="line-310"></a><span class='hs-comment'>----------------------------------------------------------------------</span>
<a name="line-311"></a>
<a name="line-312"></a><a name="getSpeed"></a><span class='hs-comment'>{- | Returns the speed in units processed per time unit. (If you are
<a name="line-313"></a>using the default time source, this would be units processed per second).
<a name="line-314"></a>This obtains the current speed solely from analyzing the 'Progress' object.
<a name="line-315"></a>
<a name="line-316"></a>If no time has elapsed yet, returns 0.
<a name="line-317"></a>
<a name="line-318"></a>You can use this against either a 'Progress' object or a 'ProgressStatus'
<a name="line-319"></a>object. This is in the IO monad because the speed is based on the current
<a name="line-320"></a>time.
<a name="line-321"></a>
<a name="line-322"></a>Example:
<a name="line-323"></a>
<a name="line-324"></a>> getSpeed progressobj >>= print
<a name="line-325"></a>
<a name="line-326"></a>Don't let the type of this function confuse you. It is a fancy way of saying
<a name="line-327"></a>that it can take either a 'Progress' or a 'ProgressStatus' object, and returns
<a name="line-328"></a>a number that is valid as any Fractional type, such as a Double, Float, or
<a name="line-329"></a>Rational. -}</span>
<a name="line-330"></a><span class='hs-definition'>getSpeed</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-varid'>b</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>Fractional</span> <span class='hs-varid'>b</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-varid'>b</span>
<a name="line-331"></a><span class='hs-definition'>getSpeed</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withStatus</span> <span class='hs-varid'>po</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>status</span> <span class='hs-keyglyph'>-></span>
<a name="line-332"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>t</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>timeSource</span> <span class='hs-varid'>status</span>
<a name="line-333"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>elapsed</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>t</span> <span class='hs-comment'>-</span> <span class='hs-layout'>(</span><span class='hs-varid'>startTime</span> <span class='hs-varid'>status</span><span class='hs-layout'>)</span>
<a name="line-334"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>elapsed</span> <span class='hs-varop'>==</span> <span class='hs-num'>0</span>
<a name="line-335"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>fromRational</span> <span class='hs-num'>0</span>
<a name="line-336"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>fromRational</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>completedUnits</span> <span class='hs-varid'>status</span><span class='hs-layout'>)</span> <span class='hs-varop'>%</span> <span class='hs-varid'>elapsed</span><span class='hs-layout'>)</span>
<a name="line-337"></a>
<a name="line-338"></a><a name="getETR"></a><span class='hs-comment'>{- | Returns the estimated time remaining, in standard time units.
<a name="line-339"></a>
<a name="line-340"></a>Returns 0 whenever 'getSpeed' would return 0.
<a name="line-341"></a>
<a name="line-342"></a>See the comments under 'getSpeed' for information about this function's type
<a name="line-343"></a>and result. -}</span>
<a name="line-344"></a><span class='hs-definition'>getETR</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-conid'>Integer</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-345"></a> <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-conid'>Rational</span><span class='hs-layout'>)</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-conid'>Integer</span>
<a name="line-346"></a><span class='hs-definition'>getETR</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>=</span>
<a name="line-347"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>speed</span> <span class='hs-keyglyph'><-</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>getSpeed</span> <span class='hs-varid'>po</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>::</span><span class='hs-conid'>IO</span> <span class='hs-conid'>Rational</span><span class='hs-layout'>)</span>
<a name="line-348"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>speed</span> <span class='hs-varop'>==</span> <span class='hs-num'>0</span>
<a name="line-349"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-num'>0</span>
<a name="line-350"></a> <span class='hs-keyword'>else</span>
<a name="line-351"></a> <span class='hs-comment'>-- FIXME: potential for a race condition here, but it should</span>
<a name="line-352"></a> <span class='hs-comment'>-- be negligible</span>
<a name="line-353"></a> <span class='hs-varid'>withStatus</span> <span class='hs-varid'>po</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>status</span> <span class='hs-keyglyph'>-></span>
<a name="line-354"></a> <span class='hs-keyword'>do</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>remaining</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>totalUnits</span> <span class='hs-varid'>status</span> <span class='hs-comment'>-</span> <span class='hs-varid'>completedUnits</span> <span class='hs-varid'>status</span>
<a name="line-355"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>round</span> <span class='hs-varop'>$</span> <span class='hs-layout'>(</span><span class='hs-varid'>toRational</span> <span class='hs-varid'>remaining</span><span class='hs-layout'>)</span> <span class='hs-varop'>/</span> <span class='hs-varid'>speed</span>
<a name="line-356"></a>
<a name="line-357"></a><a name="getETA"></a><span class='hs-comment'>{- | Returns the estimated system clock time of completion, in standard
<a name="line-358"></a>time units. Returns the current time whenever 'getETR' would return 0.
<a name="line-359"></a>
<a name="line-360"></a>See the comments under 'getSpeed' for information about this function's type
<a name="line-361"></a>and result. -}</span>
<a name="line-362"></a><span class='hs-definition'>getETA</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-conid'>Integer</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-363"></a> <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-conid'>Rational</span><span class='hs-layout'>)</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-conid'>Integer</span>
<a name="line-364"></a><span class='hs-definition'>getETA</span> <span class='hs-varid'>po</span> <span class='hs-keyglyph'>=</span>
<a name="line-365"></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'>po</span>
<a name="line-366"></a> <span class='hs-comment'>-- FIXME: similar race potential here</span>
<a name="line-367"></a> <span class='hs-varid'>withStatus</span> <span class='hs-varid'>po</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>status</span> <span class='hs-keyglyph'>-></span>
<a name="line-368"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>timenow</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>timeSource</span> <span class='hs-varid'>status</span>
<a name="line-369"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-varid'>timenow</span> <span class='hs-varop'>+</span> <span class='hs-varid'>etr</span>
<a name="line-370"></a>
<a name="line-371"></a><a name="defaultTimeSource"></a><span class='hs-comment'>----------------------------------------------------------------------</span>
<a name="line-372"></a><span class='hs-comment'>-- Utilities</span>
<a name="line-373"></a><span class='hs-comment'>----------------------------------------------------------------------</span>
<a name="line-374"></a><span class='hs-comment'>{- | The default time source for the system. This is defined as:
<a name="line-375"></a>
<a name="line-376"></a>>getClockTime >>= (return . clockTimeToEpoch)
<a name="line-377"></a>-}</span>
<a name="line-378"></a><span class='hs-definition'>defaultTimeSource</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressTimeSource</span>
<a name="line-379"></a><span class='hs-definition'>defaultTimeSource</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>getClockTime</span> <span class='hs-varop'>>>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>return</span> <span class='hs-varop'>.</span> <span class='hs-varid'>clockTimeToEpoch</span><span class='hs-layout'>)</span>
<a name="line-380"></a>
<a name="line-381"></a><a name="now"></a><span class='hs-definition'>now</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressRecords</span> <span class='hs-varid'>a</span> <span class='hs-conid'>ProgressTimeSource</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ProgressTimeSource</span>
<a name="line-382"></a><span class='hs-definition'>now</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withRecord</span> <span class='hs-varid'>x</span> <span class='hs-layout'>(</span><span class='hs-varid'>timeSource</span> <span class='hs-varop'>.</span> <span class='hs-varid'>status</span><span class='hs-layout'>)</span>
<a name="line-383"></a>
<a name="line-384"></a><a name="modStatus"></a><span class='hs-definition'>modStatus</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-conid'>ProgressStatus</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ProgressStatus</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-385"></a><span class='hs-comment'>-- FIXME/TODO: handle parents</span>
<a name="line-386"></a><span class='hs-definition'>modStatus</span> <span class='hs-layout'>(</span><span class='hs-conid'>Progress</span> <span class='hs-varid'>mp</span><span class='hs-layout'>)</span> <span class='hs-varid'>func</span> <span class='hs-keyglyph'>=</span>
<a name="line-387"></a> <span class='hs-varid'>modifyMVar_</span> <span class='hs-varid'>mp</span> <span class='hs-varid'>modfunc</span>
<a name="line-388"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>modfunc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressRecord</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>ProgressRecord</span>
<a name="line-389"></a> <span class='hs-varid'>modfunc</span> <span class='hs-varid'>oldpr</span> <span class='hs-keyglyph'>=</span>
<a name="line-390"></a> <span class='hs-keyword'>do</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>newpr</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>oldpr</span> <span class='hs-layout'>{</span><span class='hs-varid'>status</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>func</span> <span class='hs-layout'>(</span><span class='hs-varid'>status</span> <span class='hs-varid'>oldpr</span><span class='hs-layout'>)</span><span class='hs-layout'>}</span>
<a name="line-391"></a> <span class='hs-varid'>mapM_</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'>x</span> <span class='hs-layout'>(</span><span class='hs-varid'>status</span> <span class='hs-varid'>oldpr</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>status</span> <span class='hs-varid'>newpr</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-392"></a> <span class='hs-layout'>(</span><span class='hs-varid'>callbacks</span> <span class='hs-varid'>oldpr</span><span class='hs-layout'>)</span>
<a name="line-393"></a>
<a name="line-394"></a> <span class='hs-comment'>-- Kick it up to the parents.</span>
<a name="line-395"></a> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>completedUnits</span> <span class='hs-varop'>.</span> <span class='hs-varid'>status</span> <span class='hs-varop'>$</span> <span class='hs-varid'>newpr</span><span class='hs-layout'>)</span> <span class='hs-comment'>-</span>
<a name="line-396"></a> <span class='hs-layout'>(</span><span class='hs-varid'>completedUnits</span> <span class='hs-varop'>.</span> <span class='hs-varid'>status</span> <span class='hs-varop'>$</span> <span class='hs-varid'>oldpr</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-397"></a> <span class='hs-num'>0</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-398"></a> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>callParents</span> <span class='hs-varid'>newpr</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'>incrP'</span> <span class='hs-varid'>y</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-399"></a> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>totalUnits</span> <span class='hs-varop'>.</span> <span class='hs-varid'>status</span> <span class='hs-varop'>$</span> <span class='hs-varid'>newpr</span><span class='hs-layout'>)</span> <span class='hs-comment'>-</span>
<a name="line-400"></a> <span class='hs-layout'>(</span><span class='hs-varid'>totalUnits</span> <span class='hs-varop'>.</span> <span class='hs-varid'>status</span> <span class='hs-varop'>$</span> <span class='hs-varid'>oldpr</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-401"></a> <span class='hs-num'>0</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-402"></a> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>callParents</span> <span class='hs-varid'>newpr</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'>incrTotal</span> <span class='hs-varid'>y</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-403"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>newpr</span>
<a name="line-404"></a>
<a name="line-405"></a><a name="callParents"></a><span class='hs-definition'>callParents</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ProgressRecord</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Progress</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-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-406"></a><span class='hs-definition'>callParents</span> <span class='hs-varid'>pr</span> <span class='hs-varid'>func</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mapM_</span> <span class='hs-varid'>func</span> <span class='hs-layout'>(</span><span class='hs-varid'>parents</span> <span class='hs-varid'>pr</span><span class='hs-layout'>)</span>
<a name="line-407"></a>
</pre></body>
</html>
distrib
>
Fedora
>
14
>
x86_64
>
media
>
updates
>
by-pkgid
>
ec5844e219498f2057da8f8f3070d4a1
>
files
>
278
