Using a Supply timer, a thread, and promises to create a progress bar

Progress bar Demo
A simple progress bar was the target of my attention a few months back. It would consist of 3 parts:

1. Capture the output from stdout
1. Some sort of timer to update the progress bar
1. A way to start/stop these based on code passed in by the user

And to use it we would want to do the following:

my $result = WAITING-ANIMATION {
    do-something()
}, 'Some Message';

What we would like to happen is any code that is running inside WAITING-ANIMATION { ... } will be printed as usual, but also for the last row to display ===> Some Message. We would use ===> as the progress bar itself, and replace individual = for - to represent progress taking place. It would also need to update itself every second, otherwise our long running blocks of code may make it appear frozen all together.

sub WAITING-ANIMATION(&code, $status) is export {
    say "Starting...";
    my $promise = Promise.new;
    my $vow     = $promise.vow;
    my $wait-for = start { show-await($status, $promise) };

    my $retval = code();

    $vow.keep(1);
    await $wait-for;

    return $retval;
}

As you may have noticed, &code is the code inside the first block of WAITING-ANIMATION. That is, the block after WAITING-ANIMATION itself is the parameter. So our plan will be to promise to finish our &code, and in the mean time we will spawn a thread to manage STDOUT so we can update it at least every second. $wait-for will be set to a Promise to be kept or broken when the thread running show-await has noticed all the @promises passed in have been kept/broken and has finished its clean-up code.

sub show-await($status, *@promises) {
    my $loading = Supply.interval(1);
    my $out = $*OUT;
    my $err = $*ERR;

    $*ERR = $*OUT = class :: {
        my $bar;
        my $i;
        my $last-line-len = 0;

        $loading.tap({
            $bar = do given ++$i { 
                when 2  { "-==" }
                when 3  { "=-=" }
                when 4  { "==-" }
                default { $i = 1; "===" }
            }

            print "";
        });

        method print(*@_) {
            if @_ {
                my $hijacked  = @_.join;
                my $msg       = "$bar> $status...\r";
                my $output    = ($last-line-len 
                    ?? ((" " x $last-line-len) ~ "\r") 
                    !! '') ~ $hijacked ~ $msg;
                $last-line-len = $output.lines.[*-1].chars;

                my $out2 = $*OUT;
                $*ERR = $*OUT = $out;
                print $output;
                $*ERR = $*OUT = $out2;
            }
        }
        method flush {}
    }

    await Promise.allof: @promises;
    $loading.close;
    $*ERR = $err;
    $*OUT = $out;
}

This is slightly more intimidating (and thats probably my fault) but when broken down it is actually not hard to follow.

sub show-await($message, *@promises) {
    my $loading = Supply.interval(1);

*@promises is any number of promises that need to be completed in the main thread before we want to quit showing the status bar for a particular block of code. $loading easily takes care of our once-per-second timer requirement with a Supply using an interval^[1]. which will we tap^[2] to run some code during every time interval.

    my $out = $*OUT;
    my $err = $*ERR;

$*OUT and $*ERR are STDOUT and STDERR. Normally when you want to capture output from these you could just use IO::Capture::Simple^[3]. We will be doing it the long way, so we will need to assign some stuff to $*OUT and $*ERR. To return these back to their original values we save them to $out and $err. I imagine temp $*OUT should work as well.

$*ERR = $*OUT = class :: {
    method print(@_) { print @_.join }
    method flush {}
}

The code above is stripped down from the original, and left with the essentials required to capture output. We created an anonymous class to override print and flush, so if anything calls $*OUT.print or $*ERR.print we can now man-in-the-middle the process to keep our progress bar on the bottom.

    $*ERR = $*OUT = class :: {
        my $bar;
        my $i;
        my $last-line-len = 0;

$bar will hold 1 of 4 possible states the progress bar itself can be in (===, -==, etc). $i will act as a string index so we know which = needs to change. $last-line-len is a PITA. We would be using \r to get the cursor to the start of the current line, but if the line to get printed was not longer than the progress bar then you would get mangled text like Died Some Message instead of Died. This means we would have to hide this text ourselves using spaces, so we require the previous length to know how much space is required to accomplish this.

        $loading.tap({
            $bar = do given ++$i { 
                when 2  { "-==" }
                when 3  { "=-=" }
                when 4  { "==-" }
                default { $i = 1; "===" }
            }

            print "";
        });

Earlier we created my $loading = Supply.interval(1);, so the code above will be fired off every second. The code being run sets $bar to its next display state or starts over. Then we do print "", but why?

        method print(*@_) {
            if @_ {
                my $hijacked  = @_.join;
                my $msg       = "$bar> $message...\r";
                my $output    = ($last-line-len 
                    ?? ((" " x $last-line-len) ~ "\r") 
                    !! '') ~ $hijacked ~ $msg;
                $last-line-len = $output.lines.[*-1].chars;

                my $out2 = $*OUT;
                $*ERR = $*OUT = $out;
                print $output;
                $*ERR = $*OUT = $out2;
            }
        }

The reason why is because our requirement is for the progress bar to always be at the very bottom row. So anytime anything calls print, we:

1. Look at $last-line-len so we can print over the old progress bar display state with spaces
1. Print what was originally requested
1. Print the progress bar again so its at the bottom again.

So earlier we called print "" because we had just updated the state of the progress bar in $bar and wanted to display this new state (but had no other text to print).

We use the magic of \r to return the cursor to the start of a line. If we need to hide text with spaces then we need to \r twice... once to go to the start of the line, and once to return to the start after we have cleared the line. Why not do the \r at the start of the line you ask? You could, but you would find that some terminals will ignore a \r as the start of a string (or handle it different). Infact, \r is currently acting incorrectly on Win32 MoarVM, so for Zef^[4] we even re-wrote this using \bs (but I don't expect \r to be broke for long, and the \b code is even uglier). This can be viewed in Zef::CLI::StatusBar ^[5]

                my $out2 = $*OUT;
                $*ERR = $*OUT = $out;
                print $output;
                $*ERR = $*OUT = $out2;

The last bit we temporarily return $*OUT and $*ERR to their original, can-print-to-stdout, selves and call the original print with our new lines and progress bar. Then we go back to capturing output.

All we need now is to put it into a module we can reuse, and some code to demonstrate its usage...

my $result = WAITING-ANIMATION {
    my $fake-work = Supply.interval(2.1);
    $fake-work.tap: { print "{time}\n" }
    sleep(20);
}, 'Lookin real busy';

This will act as our demo. It will print the epoch time repeadedtly for 20 seconds. We set the interval to 2.1 so that the output is slower than the progress bar updates. Lets put it all together in a file progress.pl6:

module ProgressBar {
    sub WAITING-ANIMATION(&code, $status) is export {
        say "Starting...";
        my $promise = Promise.new;
        my $vow     = $promise.vow;
        my $wait-for = start { show-await($status, $promise) };

        my $retval = code();

        $vow.keep(1);
        await $wait-for;

        return $retval;
    }

    sub show-await($message, *@promises) {
        my $loading = Supply.interval(1);
        my $out = $*OUT;
        my $err = $*ERR;

        $*ERR = $*OUT = class :: {
            my $bar;
            my $i;
            my $last-line-len = 0;

            $loading.tap({
                $bar = do given ++$i { 
                    when 2  { "-==" }
                    when 3  { "=-=" }
                    when 4  { "==-" }
                    default { $i = 1; "===" }
                }

                print "";
            });

            method print(*@_) {
                if @_ {
                    my $hijacked  = @_.join;
                    my $msg       = "$bar> $message...\r";
                    my $output    = ($last-line-len 
                        ?? ((" " x $last-line-len) ~ "\r") 
                        !! '') ~ $hijacked ~ $msg;
                    $last-line-len = $output.lines.[*-1].chars;

                    my $out2 = $*OUT;
                    $*ERR = $*OUT = $out;
                    print $output;
                    $*ERR = $*OUT = $out2;
                }
            }
            method flush {}
        }

        await Promise.allof: @promises;
        $loading.close;
        $*ERR = $err;
        $*OUT = $out;
    }
}
import ProgressBar;

my $result = WAITING-ANIMATION {
    my $fake-work = Supply.interval(2.1);
    $fake-work.tap: { print "{time}\n" }
    sleep(20);
}, 'Lookin real busy';

Example output:

perl6 progress.pl6
Starting...
1437796120
1437796122
1437796124
1437796126
-==> Lookin real busy...

http://doc.perl6.org/type/Supply#method_interval ↩︎
http://doc.perl6.org/type/Tap ↩︎
IO::Capture::Simple ↩︎
Zef ↩︎
Zef::CLI::StatusBar Usage of \b instead of \r ↩︎

← death by Perl 6

Using supply timers and promises to create a Perl6 terminal progress bar