    {-# LANGUAGE Safe #-}
    {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
    {-
    Copyright (c) 2006-2011 John Goerzen <jgoerzen@complete.org>

    All rights reserved.

    For license and copyright information, see the file LICENSE
    -}

    {- |
       Module     : Data.Progress.Tracker
       Copyright  : Copyright (C) 2006-2011 John Goerzen
       SPDX-License-Identifier: BSD-3-Clause

       Stability  : stable
       Portability: portable

    Tools for tracking the status of a long operation.

    Written by John Goerzen, jgoerzen\@complete.org

    See also "Data.Progress.Meter" -}

    module Data.Progress.Tracker (
                                     -- * Introduction
                                     -- $introduction
                                     -- ** Examples
                                     -- $examples
                                     -- * Creation and Options
                                     newProgress, newProgress',
                                     addCallback, addParent,
                                     -- * Updating
                                     incrP, incrP', setP, setP', incrTotal,
                                     setTotal, finishP,
                                     -- * Reading and Processing
                                     getSpeed,
                                     withStatus,
                                     getETR,
                                     getETA,
                                     -- * Types
                                     ProgressStatus(..),
                                     Progress, ProgressTimeSource,
                                     ProgressCallback,
                                     ProgressStatuses,
                                     -- * Utilities
                                     defaultTimeSource
                                   )

    where
    import safe Control.Concurrent.MVar
        ( modifyMVar_, withMVar, newMVar, MVar )
    import safe System.Time ( getClockTime )
    import safe System.Time.Utils ( clockTimeToEpoch )
    import safe Data.Ratio ( (%) )

    {- $introduction

    ProgressTracker is a module for tracking the progress on long-running
    operations.  It can be thought of as the back end engine behind
    a status bar.  ProgressTracker can do things such as track how far along
    a task is, provide an estimated time of completion, estimated time remaining,
    current speed, etc.  It is designed to be as generic as possible; it can even
    base its speed calculations on something other than the system clock.

    ProgressTracker also supports a notion of a parent tracker.  This is used when
    a large task is composed of several individual tasks which may also be
    long-running.  Downloading many large files over the Internet is a common
    example of this.

    Any given ProgressTracker can be told about one or more parent trackers.
    When the child tracker's status is updated, the parent tracker's status is
    also updated in the same manner.  Therefore, the progress on each individual
    component, as well as the overall progress, can all be kept in sync
    automatically.

    Finally, you can register callbacks.  Callbacks are functions that are called
    whenever the status of a tracker changes.  They'll be passed the old and new
    status and are intended to do things like update on-screen status displays.

    The cousin module 'Data.Progress.Meter' can be used to nicely render
    these trackers on a console.
    -}

    {- $examples

    Here is an example use:

    >do prog <- newProgress "mytracker" 1024
    >   incrP prog 10
    >   getETR prog >>= print           -- prints number of seconds remaining
    >   incrP prog 500
    >   finishP prog
    -}

    ----------------------------------------------------------------------
    -- TYPES
    ----------------------------------------------------------------------

    {- | A function that, when called, yields the current time.
    The default is 'defaultTimeSource'. -}
    type ProgressTimeSource = IO Integer

    {- | The type for a callback function for the progress tracker.
    When given at creation time to 'newProgress\'' or when added via 'addCallback',
    these functions get called every time the status of the tracker changes.

    This function is passed two 'ProgressStatus' records: the first
    reflects the status prior to the update, and the second reflects
    the status after the update.

    Please note that the owning 'Progress' object will be locked while the
    callback is running, so the callback will not be able to make changes to it. -}
    type ProgressCallback = ProgressStatus -> ProgressStatus -> IO ()

    {- | The main progress status record. -}
    data ProgressStatus =
         ProgressStatus {ProgressStatus -> Integer
    completedUnits :: Integer,
                         ProgressStatus -> Integer
    totalUnits :: Integer,
                         ProgressStatus -> Integer
    startTime :: Integer,
                         ProgressStatus -> String
    trackerName :: String, -- ^ An identifying string
                         ProgressStatus -> ProgressTimeSource
    timeSource :: ProgressTimeSource
                        }

    data ProgressRecord =
        ProgressRecord {ProgressRecord -> [Progress]
    parents :: [Progress],
                        ProgressRecord -> [ProgressCallback]
    callbacks :: [ProgressCallback],
                        ProgressRecord -> ProgressStatus
    status :: ProgressStatus}

    {- | The main Progress object. -}
    newtype Progress = Progress (MVar ProgressRecord)

    class ProgressStatuses a b where
        {- | Lets you examine the 'ProgressStatus' that is contained
           within a 'Progress' object.  You can simply pass
           a 'Progress' object and a function to 'withStatus', and
           'withStatus' will lock the 'Progress' object (blocking any
           modifications while you are reading it), then pass the object
           to your function.  If you happen to already have a 'ProgressStatus'
           object, withStatus will also accept it and simply pass it unmodified
           to the function. -}
        withStatus :: a -> (ProgressStatus -> b) -> b

    instance ProgressStatuses Progress (IO b) where
        withStatus :: Progress -> (ProgressStatus -> IO b) -> IO b
    withStatus (Progress MVar ProgressRecord
    x) ProgressStatus -> IO b
    func = MVar ProgressRecord -> (ProgressRecord -> IO b) -> IO b
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar ProgressRecord
    x (\ProgressRecord
    y -> ProgressStatus -> IO b
    func (ProgressRecord -> ProgressStatus
    status ProgressRecord
    y))

    instance ProgressStatuses ProgressStatus b where
        withStatus :: ProgressStatus -> (ProgressStatus -> b) -> b
    withStatus ProgressStatus
    x ProgressStatus -> b
    func = ProgressStatus -> b
    func ProgressStatus
    x

    ----------------------------------------------------------------------
    -- Creation
    ----------------------------------------------------------------------

    {- | Create a new 'Progress' object with the given name and number
    of total units initialized as given.  The start time will be initialized
    with the current time at the present moment according to the system clock.
    The units completed will be set to 0, the time source will be set to the
    system clock, and the parents and callbacks will be empty.

    If you need more control, see 'newProgress\''.

    Example:

    > prog <- newProgress "mytracker" 1024

    -}
    newProgress :: String           -- ^ Name of this tracker
                -> Integer          -- ^ Total units expected
                -> IO Progress
    newProgress :: String -> Integer -> IO Progress
    newProgress String
    name Integer
    total =
        do t <- ProgressTimeSource
    defaultTimeSource
           newProgress' (ProgressStatus {completedUnits = 0, totalUnits = total,
                                         startTime = t, trackerName = name,
                                         timeSource = defaultTimeSource})
                        []

    {- | Create a new 'Progress' object initialized with the given status and
    callbacks.
    No adjustment to the 'startTime' will be made.  If you
    want to use the system clock, you can initialize 'startTime' with
    the return value of 'defaultTimeSource' and also pass 'defaultTimeSource'
    as the timing source. -}
    newProgress' :: ProgressStatus
                 -> [ProgressCallback] -> IO Progress
    newProgress' :: ProgressStatus -> [ProgressCallback] -> IO Progress
    newProgress' ProgressStatus
    news [ProgressCallback]
    newcb =
        do r <- ProgressRecord -> IO (MVar ProgressRecord)
    forall a. a -> IO (MVar a)
    newMVar (ProgressRecord -> IO (MVar ProgressRecord))
    -> ProgressRecord -> IO (MVar ProgressRecord)
    forall a b. (a -> b) -> a -> b
    $ ProgressRecord {parents :: [Progress]
    parents = [],
                                          callbacks :: [ProgressCallback]
    callbacks = [ProgressCallback]
    newcb, status :: ProgressStatus
    status = ProgressStatus
    news}
           return (Progress r)

    {- | Adds an new callback to an existing 'Progress'.  The callback will be
    called whenever the object's status is updated, except by the call to finishP.

    Please note that the Progress object will be locked while the callback is
    running, so the callback will not be able to make any modifications to it.
    -}
    addCallback :: Progress -> ProgressCallback -> IO ()
    addCallback :: Progress -> ProgressCallback -> IO ()
    addCallback (Progress MVar ProgressRecord
    mpo) ProgressCallback
    cb = MVar ProgressRecord
    -> (ProgressRecord -> IO ProgressRecord) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar ProgressRecord
    mpo ((ProgressRecord -> IO ProgressRecord) -> IO ())
    -> (ProgressRecord -> IO ProgressRecord) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ProgressRecord
    po ->
        ProgressRecord -> IO ProgressRecord
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ProgressRecord -> IO ProgressRecord)
    -> ProgressRecord -> IO ProgressRecord
    forall a b. (a -> b) -> a -> b
    $ ProgressRecord
    po {callbacks = cb : callbacks po}

    {- | Adds a new parent to an existing 'Progress'.  The parent
    will automatically have its completed and total counters incremented
    by the value of those counters in the existing 'Progress'. -}
    addParent :: Progress           -- ^ The child object
              -> Progress           -- ^ The parent to add to this child
              -> IO ()
    addParent :: Progress -> Progress -> IO ()
    addParent (Progress MVar ProgressRecord
    mcpo) Progress
    ppo = MVar ProgressRecord
    -> (ProgressRecord -> IO ProgressRecord) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar ProgressRecord
    mcpo ((ProgressRecord -> IO ProgressRecord) -> IO ())
    -> (ProgressRecord -> IO ProgressRecord) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ProgressRecord
    cpo ->
        do Progress -> Integer -> IO ()
    incrP' Progress
    ppo (ProgressStatus -> Integer
    completedUnits (ProgressStatus -> Integer)
    -> (ProgressRecord -> ProgressStatus) -> ProgressRecord -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ProgressRecord -> ProgressStatus
    status (ProgressRecord -> Integer) -> ProgressRecord -> Integer
    forall a b. (a -> b) -> a -> b
    $ ProgressRecord
    cpo)
           Progress -> Integer -> IO ()
    incrTotal Progress
    ppo (ProgressStatus -> Integer
    totalUnits (ProgressStatus -> Integer)
    -> (ProgressRecord -> ProgressStatus) -> ProgressRecord -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ProgressRecord -> ProgressStatus
    status (ProgressRecord -> Integer) -> ProgressRecord -> Integer
    forall a b. (a -> b) -> a -> b
    $ ProgressRecord
    cpo)
           ProgressRecord -> IO ProgressRecord
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ProgressRecord -> IO ProgressRecord)
    -> ProgressRecord -> IO ProgressRecord
    forall a b. (a -> b) -> a -> b
    $ ProgressRecord
    cpo {parents = ppo : parents cpo}

    {- | Call this when you are finished with the object.  It is especially
    important to do this when parent objects are involved.

    This will simply set the totalUnits to the current completedUnits count,
    but will not call the callbacks.  It will additionally propogate
    any adjustment in totalUnits to the parents, whose callbacks /will/ be
    called.

    This ensures that the total expected counts on the parent are always correct.
    Without doing this, if, say, a transfer ended earlier than expected, ETA
    values on the parent would be off since it would be expecting more data than
    actually arrived. -}
    finishP :: Progress -> IO ()
    finishP :: Progress -> IO ()
    finishP (Progress MVar ProgressRecord
    mp) =
        MVar ProgressRecord
    -> (ProgressRecord -> IO ProgressRecord) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar ProgressRecord
    mp ProgressRecord -> IO ProgressRecord
    modfunc
        where modfunc :: ProgressRecord -> IO ProgressRecord
              modfunc :: ProgressRecord -> IO ProgressRecord
    modfunc ProgressRecord
    oldpr =
                  do let adjustment :: Integer
    adjustment = (ProgressStatus -> Integer
    completedUnits (ProgressStatus -> Integer)
    -> (ProgressRecord -> ProgressStatus) -> ProgressRecord -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ProgressRecord -> ProgressStatus
    status (ProgressRecord -> Integer) -> ProgressRecord -> Integer
    forall a b. (a -> b) -> a -> b
    $ ProgressRecord
    oldpr)
                                      Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - (ProgressStatus -> Integer
    totalUnits (ProgressStatus -> Integer)
    -> (ProgressRecord -> ProgressStatus) -> ProgressRecord -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ProgressRecord -> ProgressStatus
    status (ProgressRecord -> Integer) -> ProgressRecord -> Integer
    forall a b. (a -> b) -> a -> b
    $ ProgressRecord
    oldpr)
                     ProgressRecord -> (Progress -> IO ()) -> IO ()
    callParents ProgressRecord
    oldpr (\Progress
    x -> Progress -> Integer -> IO ()
    incrTotal Progress
    x Integer
    adjustment)
                     ProgressRecord -> IO ProgressRecord
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ProgressRecord -> IO ProgressRecord)
    -> ProgressRecord -> IO ProgressRecord
    forall a b. (a -> b) -> a -> b
    $ ProgressRecord
    oldpr {status = (status oldpr)
                                     {totalUnits = completedUnits . status $ oldpr}}

    ----------------------------------------------------------------------
    -- Updating
    ----------------------------------------------------------------------
    {- | Increment the completed unit count in the 'Progress' object
    by the amount given.  If the value as given exceeds the total, then
    the total will also be raised to match this value so that the
    completed count never exceeds the total.

    You can decrease the completed unit count by supplying a negative number
    here. -}
    incrP :: Progress -> Integer -> IO ()
    incrP :: Progress -> Integer -> IO ()
    incrP Progress
    po Integer
    count = Progress -> (ProgressStatus -> ProgressStatus) -> IO ()
    modStatus Progress
    po ProgressStatus -> ProgressStatus
    statusfunc
        where statusfunc :: ProgressStatus -> ProgressStatus
    statusfunc ProgressStatus
    s =
                 ProgressStatus
    s {completedUnits = newcu s,
                    totalUnits = if newcu s > totalUnits s
                                     then newcu s
                                     else totalUnits s}
              newcu :: ProgressStatus -> Integer
    newcu ProgressStatus
    s = ProgressStatus -> Integer
    completedUnits ProgressStatus
    s Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    count

    {- | Like 'incrP', but never modify the total. -}
    incrP' :: Progress -> Integer -> IO ()
    incrP' :: Progress -> Integer -> IO ()
    incrP' Progress
    po Integer
    count =
        Progress -> (ProgressStatus -> ProgressStatus) -> IO ()
    modStatus Progress
    po (\ProgressStatus
    s -> ProgressStatus
    s {completedUnits = completedUnits s + count})

    {- | Set the completed unit count in the 'Progress' object to the specified
    value.  Unlike 'incrP', this function sets the count to a specific value,
    rather than adding to the existing value.  If this value exceeds the total,
    then the total will also be raised to match this value so that the completed
    count never exceeds teh total. -}
    setP :: Progress -> Integer -> IO ()
    setP :: Progress -> Integer -> IO ()
    setP Progress
    po Integer
    count = Progress -> (ProgressStatus -> ProgressStatus) -> IO ()
    modStatus Progress
    po ProgressStatus -> ProgressStatus
    statusfunc
        where statusfunc :: ProgressStatus -> ProgressStatus
    statusfunc ProgressStatus
    s =
                  ProgressStatus
    s {completedUnits = count,
                     totalUnits = if count > totalUnits s
                                      then count
                                      else totalUnits s}

    {- | Like 'setP', but never modify the total. -}
    setP' :: Progress -> Integer -> IO ()
    setP' :: Progress -> Integer -> IO ()
    setP' Progress
    po Integer
    count = Progress -> (ProgressStatus -> ProgressStatus) -> IO ()
    modStatus Progress
    po (\ProgressStatus
    s -> ProgressStatus
    s {completedUnits = count})

    {- | Increment the total unit count in the 'Progress' object by the amount
    given.  This would rarely be needed, but could be needed in some special cases
    when the total number of units is not known in advance. -}
    incrTotal :: Progress -> Integer -> IO ()
    incrTotal :: Progress -> Integer -> IO ()
    incrTotal Progress
    po Integer
    count =
        Progress -> (ProgressStatus -> ProgressStatus) -> IO ()
    modStatus Progress
    po (\ProgressStatus
    s -> ProgressStatus
    s {totalUnits = totalUnits s + count})

    {- | Set the total unit count in the 'Progress' object to the specified
    value.  Like 'incrTotal', this would rarely be needed. -}
    setTotal :: Progress -> Integer -> IO ()
    setTotal :: Progress -> Integer -> IO ()
    setTotal Progress
    po Integer
    count =
        Progress -> (ProgressStatus -> ProgressStatus) -> IO ()
    modStatus Progress
    po (\ProgressStatus
    s -> ProgressStatus
    s {totalUnits = count})

    ----------------------------------------------------------------------
    -- Reading and Processing
    ----------------------------------------------------------------------

    {- | Returns the speed in units processed per time unit.  (If you are
    using the default time source, this would be units processed per second).
    This obtains the current speed solely from analyzing the 'Progress' object.

    If no time has elapsed yet, returns 0.

    You can use this against either a 'Progress' object or a 'ProgressStatus'
    object.  This is in the IO monad because the speed is based on the current
    time.

    Example:

    > getSpeed progressobj >>= print

    Don't let the type of this function confuse you.  It is a fancy way of saying
    that it can take either a 'Progress' or a 'ProgressStatus' object, and returns
    a number that is valid as any Fractional type, such as a Double, Float, or
    Rational. -}
    getSpeed :: (ProgressStatuses a (IO b), Fractional b) => a -> IO b
    getSpeed :: forall a b. (ProgressStatuses a (IO b), Fractional b) => a -> IO b
    getSpeed a
    po = a -> (ProgressStatus -> IO b) -> IO b
    forall a b. ProgressStatuses a b => a -> (ProgressStatus -> b) -> b
    withStatus a
    po ((ProgressStatus -> IO b) -> IO b)
    -> (ProgressStatus -> IO b) -> IO b
    forall a b. (a -> b) -> a -> b
    $ \ProgressStatus
    status ->
                    do t <- ProgressStatus -> ProgressTimeSource
    timeSource ProgressStatus
    status
                       let elapsed = Integer
    t Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - (ProgressStatus -> Integer
    startTime ProgressStatus
    status)
                       return $ if elapsed == 0
                           then fromRational 0
                           else fromRational ((completedUnits status) % elapsed)

    {- | Returns the estimated time remaining, in standard time units.

    Returns 0 whenever 'getSpeed' would return 0.

    See the comments under 'getSpeed' for information about this function's type
    and result. -}
    getETR :: (ProgressStatuses a (IO Integer),
               ProgressStatuses a (IO Rational)) => a -> IO Integer
    getETR :: forall a.
    (ProgressStatuses a ProgressTimeSource,
     ProgressStatuses a (IO Rational)) =>
    a -> ProgressTimeSource
    getETR a
    po =
        do speed <- ((a -> IO Rational
    forall a b. (ProgressStatuses a (IO b), Fractional b) => a -> IO b
    getSpeed a
    po)::IO Rational)
           if speed == 0
              then return 0
              else
                  -- FIXME: potential for a race condition here, but it should
                  -- be negligible
                  withStatus po $ \ProgressStatus
    status ->
                      do let remaining :: Integer
    remaining = ProgressStatus -> Integer
    totalUnits ProgressStatus
    status Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - ProgressStatus -> Integer
    completedUnits ProgressStatus
    status
                         Integer -> ProgressTimeSource
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> ProgressTimeSource) -> Integer -> ProgressTimeSource
    forall a b. (a -> b) -> a -> b
    $ Rational -> Integer
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Rational -> Integer) -> Rational -> Integer
    forall a b. (a -> b) -> a -> b
    $ (Integer -> Rational
    forall a. Real a => a -> Rational
    toRational Integer
    remaining) Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / Rational
    speed

    {- | Returns the estimated system clock time of completion, in standard
    time units.  Returns the current time whenever 'getETR' would return 0.

    See the comments under 'getSpeed' for information about this function's type
    and result. -}
    getETA :: (ProgressStatuses a (IO Integer),
               ProgressStatuses a (IO Rational)) => a -> IO Integer
    getETA :: forall a.
    (ProgressStatuses a ProgressTimeSource,
     ProgressStatuses a (IO Rational)) =>
    a -> ProgressTimeSource
    getETA a
    po =
        do etr <- a -> ProgressTimeSource
    forall a.
    (ProgressStatuses a ProgressTimeSource,
     ProgressStatuses a (IO Rational)) =>
    a -> ProgressTimeSource
    getETR a
    po
           -- FIXME: similar race potential here
           withStatus po $ \ProgressStatus
    status ->
               do timenow <- ProgressStatus -> ProgressTimeSource
    timeSource ProgressStatus
    status
                  return $ timenow + etr

    ----------------------------------------------------------------------
    -- Utilities
    ----------------------------------------------------------------------
    {- | The default time source for the system.  This is defined as:

    >getClockTime >>= (return . clockTimeToEpoch)
    -}
    defaultTimeSource :: ProgressTimeSource
    defaultTimeSource :: ProgressTimeSource
    defaultTimeSource = IO ClockTime
    getClockTime IO ClockTime
    -> (ClockTime -> ProgressTimeSource) -> ProgressTimeSource
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Integer -> ProgressTimeSource
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> ProgressTimeSource)
    -> (ClockTime -> Integer) -> ClockTime -> ProgressTimeSource
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClockTime -> Integer
    forall a. Num a => ClockTime -> a
    clockTimeToEpoch)

    modStatus :: Progress -> (ProgressStatus -> ProgressStatus) -> IO ()
    -- FIXME/TODO: handle parents
    modStatus :: Progress -> (ProgressStatus -> ProgressStatus) -> IO ()
    modStatus (Progress MVar ProgressRecord
    mp) ProgressStatus -> ProgressStatus
    func =
        MVar ProgressRecord
    -> (ProgressRecord -> IO ProgressRecord) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar ProgressRecord
    mp ProgressRecord -> IO ProgressRecord
    modfunc
        where modfunc :: ProgressRecord -> IO ProgressRecord
              modfunc :: ProgressRecord -> IO ProgressRecord
    modfunc ProgressRecord
    oldpr =
                  do let newpr :: ProgressRecord
    newpr = ProgressRecord
    oldpr {status = func (status oldpr)}
                     (ProgressCallback -> IO ()) -> [ProgressCallback] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\ProgressCallback
    x -> ProgressCallback
    x (ProgressRecord -> ProgressStatus
    status ProgressRecord
    oldpr) (ProgressRecord -> ProgressStatus
    status ProgressRecord
    newpr))
                               (ProgressRecord -> [ProgressCallback]
    callbacks ProgressRecord
    oldpr)

                     -- Kick it up to the parents.
                     case (ProgressStatus -> Integer
    completedUnits (ProgressStatus -> Integer)
    -> (ProgressRecord -> ProgressStatus) -> ProgressRecord -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ProgressRecord -> ProgressStatus
    status (ProgressRecord -> Integer) -> ProgressRecord -> Integer
    forall a b. (a -> b) -> a -> b
    $ ProgressRecord
    newpr) Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -
                          (ProgressStatus -> Integer
    completedUnits (ProgressStatus -> Integer)
    -> (ProgressRecord -> ProgressStatus) -> ProgressRecord -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ProgressRecord -> ProgressStatus
    status (ProgressRecord -> Integer) -> ProgressRecord -> Integer
    forall a b. (a -> b) -> a -> b
    $ ProgressRecord
    oldpr) of
                       Integer
    0 -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                       Integer
    x -> ProgressRecord -> (Progress -> IO ()) -> IO ()
    callParents ProgressRecord
    newpr (\Progress
    y -> Progress -> Integer -> IO ()
    incrP' Progress
    y Integer
    x)
                     case (ProgressStatus -> Integer
    totalUnits (ProgressStatus -> Integer)
    -> (ProgressRecord -> ProgressStatus) -> ProgressRecord -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ProgressRecord -> ProgressStatus
    status (ProgressRecord -> Integer) -> ProgressRecord -> Integer
    forall a b. (a -> b) -> a -> b
    $ ProgressRecord
    newpr) Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -
                          (ProgressStatus -> Integer
    totalUnits (ProgressStatus -> Integer)
    -> (ProgressRecord -> ProgressStatus) -> ProgressRecord -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ProgressRecord -> ProgressStatus
    status (ProgressRecord -> Integer) -> ProgressRecord -> Integer
    forall a b. (a -> b) -> a -> b
    $ ProgressRecord
    oldpr) of
                       Integer
    0 -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                       Integer
    x -> ProgressRecord -> (Progress -> IO ()) -> IO ()
    callParents ProgressRecord
    newpr (\Progress
    y -> Progress -> Integer -> IO ()
    incrTotal Progress
    y Integer
    x)
                     ProgressRecord -> IO ProgressRecord
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ProgressRecord
    newpr

    callParents :: ProgressRecord -> (Progress -> IO ()) -> IO ()
    callParents :: ProgressRecord -> (Progress -> IO ()) -> IO ()
    callParents ProgressRecord
    pr Progress -> IO ()
    func = (Progress -> IO ()) -> [Progress] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Progress -> IO ()
    func (ProgressRecord -> [Progress]
    parents ProgressRecord
    pr)