package Params::Callbacks;

# Copyright (c) 2012-2015 Iain Campbell. All rights reserved.
#
# This work may be used and modified freely, but I ask that the copyright
# notice remain attached to the file. You may modify this module as you
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.

=pod

=encoding utf-8

=head1 NAME

Params::Callbacks - Make your subroutines accept blocking callbacks

=head1 SYNOPSIS

    use Params::Callbacks ':all';
    use Data::Dumper;
    
    $Data::Dumper::Indent = 0;
    $Data::Dumper::Terse  = 1;
    
    sub foo
    {
        my ( $callbacks, @params ) = &callbacks;    # If &callbacks makes the hairs on 
                                                    # your neck stand up, replace it with
                                                    # the cleaner alternative:
                                                    #
                                                    # Params::Callbacks->new(@_)
        return $callbacks->transform(@params);
    }
    
    # No callbacks; no change to result!
    my @result_1 = foo( 0, 1, 2, 3 );
    print Dumper( [@result_1] ), "\n";  # [0,1,2,3]
    
    # With callback, result is transformed before being returned!
    my @result_2 = foo( 0, 1, 2, 3, callback { 0 + 2 ** $_ } );
    print Dumper( [@result_2] ), "\n";  # [1,2,4,8]
    
    # With multiple callbacks, result is transformed in multiple stages
    my @result_3 = foo( 0, 1, 2, 3, callback { 0 + 2 ** $_ } callback { 0 + 10 * $_ });
    print Dumper( [@result_3] ), "\n";  # [10,20,40,80];
    
=head1 DESCRIPTION

Use this package to enable your function or method to optionally transform
its return value, by filtering it through zero or more blocking callbacks
passed by the caller at the end of the parameter list.

At the very least, it's a bit like "map" without needing to slam your brain 
into reverse.
  
=cut

use strict;
use warnings;

use Exporter ();
use Scalar::Util qw(blessed);
use Carp qw(confess);
use namespace::clean;

our $VERSION = '2.001000';
$VERSION = eval $VERSION;

our @ISA         = qw(Exporter);
our %EXPORT_TAGS = ( all => [qw(callbacks callback)] );
our @EXPORT_OK   = @{ $EXPORT_TAGS{all} };

sub CALLBACK_CLASS () { __PACKAGE__ . '::Callback' }

=head1 METHODS

=over 2

=item B<new>

Accepts a list of arguments (usually C<@_>), stripping off any trailing 
callbacks and placing them in a list blessed as a C<Params::Callbacks> 
object. A new list is returned, beginning with the callbacks object and 
followed by any arguments that were not callbacks:

    sub my_function 
    {
        ( $callbacks, @params ) = Params::Callbacks->new(@_);
        ...
    }

Callbacks in this sense are zero or more blessed code references appearing 
at the end of an argument list. They are announced using a C<callback> 
keyword:

    my @result = my_function(1, 2, 3, callback { 'a callback' });

    my @result = my_function(1, 2, 3, callback { 'a callback' }
                                      callback { 'a second callback' });

Callbacks need not be separated by commas, but use commas if you prefer.

Unblessed code references and code references (blessed or not) followed by
standard arguments are treated as standard arguments.

=back

=cut

sub new
{
    my ( $class, @params ) = @_;

    my @callbacks;
    while ( @params && blessed( $params[-1] ) && $params[-1]->isa(CALLBACK_CLASS) )
    {
        unshift @callbacks, pop @params;
    }

    return ( bless( \@callbacks, $class ), @params );
}

=over 2

=item B<transform>

Transform a result set by passing it through all the stages of the callbacks
pipeline. The transformation terminates if the result set is reduced to 
nothing, and an empty result set is returned.

Empty or not, this method always returns a list.

=back

=cut

sub transform
{
    my ( $callbacks, @data ) = @_;

    confess 'E-PARAMS-CALLBACKS-001 Expected Params::Callbacks object reference as first argument'
      unless ref($callbacks) && $callbacks->isa(__PACKAGE__);

    for my $callback (@$callbacks)
    {
        last unless @data;
        @data = map { $callback->($_) } @data;
    }

    return @data;
}

=over 2

=item B<smart_transform>

Transform a result set by passing it through all the stages of the callbacks
pipeline. The transformation terminates if the result set is reduced to 
nothing, and an empty result set is returned.

Empty or not, this method always returns a list if a list was wanted.

If a scalar is required, a scalar is returned. If the result set contains a 
single element then the value of that element will be returned, otherwise a
count of the number of elements is returned. 

=back

=cut

sub smart_transform
{
    my @data = &transform;

    unless (wantarray)
    {
        my $result;

        if ( @data != 1 )
        {
            $result = scalar(@data);
        }
        else
        {
            $result = $data[0];
        }

        return $result;
    }

    return @data;
}

=head1 EXPORTED FUNCTIONS

=over 2

=item B<callbacks>

Accepts a list of arguments (usually C<@_>), stripping off any trailing 
callbacks and placing them in a list blessed as a C<Params::Callbacks> 
object. A new list is returned, beginning with the callbacks object and 
followed by any arguments that were not callbacks:

    sub my_function 
    {
        ( $callbacks, @params ) = callbacks(@_);
        ( $callbacks, @params ) = &callbacks;       # Alternative invocation
        ...
    }

Callbacks in this sense are zero or more blessed code references appearing 
at the end of an argument list. They are announced using a C<callback> 
keyword:

    my @result = my_function(1, 2, 3, callback { 'a callback' });

    my @result = my_function(1, 2, 3, callback { 'a callback' }
                                      callback { 'a second callback' });

Callbacks need not be separated by commas, but use commas if you prefer.

Unblessed code references and code references (blessed or not) followed by
standard arguments are treated as standard arguments.

=back

=cut

sub callbacks
{
    return __PACKAGE__->new(@_);
}

=over 2

=item B<callback>

A simple piece of syntactic sugar that announces a callback. The code
reference it precedes is blessed as a C<Params::Callbacks::Callback>
object, disambiguating it from unblessed subs that are being passed as 
standard arguments.

Multiple callbacks may be chained together with or without comma 
separators: 

    callback { ... }, callback { ... }, callback { ... }    # Valid
    callback { ... }  callback { ... }  callback { ... }    # Valid, too!
    
=back

=cut

sub callback (&;@)
{
    my ( $callback, @params ) = @_;
    return ( bless( $callback, CALLBACK_CLASS ), @params );
}

1;

=head1 BUG REPORTS

Please report any bugs to L<http://rt.cpan.org/>

=head1 AUTHOR

Iain Campbell <cpanic@cpan.org>

=head1 COPYRIGHT AND LICENCE

Copyright (C) 2012-2015 by Iain Campbell

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
