File Coverage

blib/lib/Result/Simple.pm

Criterion	Covered	Total	%
statement	184	184	100.0
branch	78	86	90.7
condition	14	27	51.8
subroutine	38	38	100.0
pod	11	12	91.6
total	325	347	93.6

package Result::Simple;
use strict;
use warnings;

our $VERSION = "0.07";

use Exporter::Shiny qw(
    ok
    err
    result_for
    chain
    pipeline
    combine
    combine_with_all_errors
    flatten
    match
    unsafe_unwrap
    unsafe_unwrap_err
);

use Carp;
use Scope::Upper ();
use Sub::Util ();
use Scalar::Util ();

# If this option is true, then check `ok` and `err` functions usage and check a return value type.
# However, it should be falsy for production code, because of performance, and it is an assertion, not a validation.
use constant CHECK_ENABLED => $ENV{RESULT_SIMPLE_CHECK_ENABLED} // 1;

# err does not allow these values.
use constant FALSY_VALUES => [0, '0', '', undef];

# When the function is successful, it should return this.
sub ok {
    if (CHECK_ENABLED) {
        croak "`ok` must be called in list context" unless wantarray;
        croak "`ok` does not allow multiple arguments" if @_ > 1;
        croak "`ok` does not allow no arguments" if @_ == 0;
    }
    ($_[0], undef)
}

# When the function fails, it should return this.
sub err {
    if (CHECK_ENABLED) {
        croak "`err` must be called in list context" unless wantarray;
        croak "`err` does not allow multiple arguments." if @_ > 1;
        croak "`err` does not allow no arguments" if @_ == 0;
        croak "`err` does not allow a falsy value: @{[ _ddf($_[0]) ]}" unless $_[0];
    }
    (undef, $_[0])
}

# result_for foo => (T, E);
# This is used to define a function that returns a success or failure.
#
# Example
#
#   result_for div => Int, ErrorMessage;
#
#   sub div {
#     my ($a, $b) = @_;
#     if ($b == 0) {
#       return err('Division by zero');
#     }
#     return ok($a / $b);
#   }
sub result_for {
    unless (CHECK_ENABLED) {
        # This is a no-op if CHECK_ENABLED is false.
        return;
    }

    my ($function_name, $T, $E, %opts) = @_;

    my @caller   = caller($opts{caller_level} || 0);
    my $package  = $opts{package} || $caller[0];
    my $filename = $caller[1];
    my $line     = $caller[2];

    my $code = $package->can($function_name);

    unless ($code) {
        croak "result_for: function `$function_name` not found in package `$package` at $filename line $line\n";
    }

    unless (Scalar::Util::blessed($T) && $T->can('check')) {
        croak "result_for T requires `check` method, got: @{[ _ddf($T) ]} at $filename line $line\n";
    }

    if (defined $E) {
        unless (Scalar::Util::blessed($E) && $E->can('check')) {
            croak "result_for E requires `check` method, got: @{[ _ddf($E) ]} at $filename line $line\n";
        }

        if (my @f = grep { $E->check($_) } @{ FALSY_VALUES() }) {
            croak "result_for E should not allow falsy values: @{[ _ddf(\@f) ]} at $filename line $line\n";
        }
    }

    wrap_code($code, $package, $function_name, $T, $E);
}

# Wrap the original coderef with type check.
sub wrap_code {
    my ($code, $package, $name, $T, $E) = @_;

    my $wrapped = sub {
        croak "Must handle error in `$name`" unless wantarray;

        my @result = &Scope::Upper::uplevel($code, @_, &Scope::Upper::CALLER(0));
        unless (@result == 2) {
            Carp::confess "Invalid result tuple (T, E) in `$name`. Do you forget to call `ok` or `err` function? Got: @{[ _ddf(\@result) ]}";
        }

        my ($data, $err) = @result;

        if ($err) {
            if (defined $E) {
                if (!$E->check($err) || defined $data) {
                    Carp::confess "Invalid failure result in `$name`: @{[ _ddf([$data, $err]) ]}";
                }
            } else {
                # Result(T, undef) should not return an error.
                Carp::confess "Never return error in `$name`: @{[ _ddf([$data, $err]) ]}";
            }
        } else {
            if (!$T->check($data) || defined $err) {
                Carp::confess "Invalid success result in `$name`: @{[ _ddf([$data, $err]) ]}";
            }
        }

        ($data, $err);
    };

    my $fullname = "$package\::$name";
    Sub::Util::set_subname($fullname, $wrapped);

    my $prototype = Sub::Util::prototype($code);
    if (defined $prototype) {
        Sub::Util::set_prototype($prototype, $wrapped);
    }

    no strict qw(refs);
    no warnings qw(redefine);
    *{$fullname} = $wrapped;
}

# `chain` takes a function name and a result tuple (T, E) and returns a new result tuple (T, E).
sub chain {
    my ($function, $value, $error) = @_;

    if (CHECK_ENABLED) {
        croak "`chain` must be called in list context" unless wantarray;
        croak "`chain` arguments must be func and result like (func, T, E)" unless @_ == 3;
    }

    my $code = ref $function ? $function : do {
        my $caller = caller(0);
        $caller->can($function) or croak "Function `$function` not found in $caller";
    };
    return err($error) if $error;
    return $code->($value);
}

# `pipeline` takes a list of function names and returns a new function.
sub pipeline {
    my (@functions) = @_;

    my @codes = map {
        my $f = $_;
        ref $f ? $f : do {
            my $caller = caller(0);
            $caller->can($f) or croak "Function `$f` not found in $caller";
        };
    } @functions;

    my $pipelined = sub {
        my ($value, $error) = @_;

        if (CHECK_ENABLED) {
            croak "pipelined function must be called in list context" unless wantarray;
            croak "pipelined function arguments must be result such as (T, E) " unless @_ == 2;
        }

        return err($error) if $error;
        for my $code (@codes) {
            ($value, $error) = $code->($value);
            return err($error) if $error;
        }
        return ok($value);
    };

    my $package = caller(0);
    my $fullname = "$package\::__PIPELINED_FUNCTION__";
    Sub::Util::set_subname($fullname, $pipelined);

    return $pipelined;
}

# `combine` takes a list of Result like `((T1,E1), (T2,E2), (T3,E3))` and returns a new Result like `([T1,T2,T3], E)`.
sub combine {
    my @results = @_;

    if (CHECK_ENABLED) {
        croak "`combine` must be called in list context" unless wantarray;
        croak "`combine` arguments must be Result list" unless @_ % 2 == 0;
    }

    my @values;
    for (my $i = 0; $i < @results; $i += 2) {
        my ($value, $error) = @results[$i, $i + 1];
        if ($error) {
            return err($error);
        }
        push @values, $value;
    }
    return ok(\@values);
}

# `combine_with_all_errors` takes a list of Result like `((T1,E1), (T2,E2), (T3,E3))` and returns a new Result like `([T1,T2,T3], [E1,E2,E3])`.
sub combine_with_all_errors {
    my @results = @_;

    if (CHECK_ENABLED) {
        croak "`combine_with_all_errors` must be called in list context" unless wantarray;
        croak "`combine_with_all_errors` arguments must be Result list" unless @_ % 2 == 0;
    }

    my @values;
    my @errors;
    for (my $i = 0; $i < @results; $i += 2) {
        my ($value, $err) = @results[$i, $i + 1];
        if ($err) {
            push @errors, $err;
        } else {
            push @values, $value;
        }
    }
    return err(\@errors) if @errors;
    return ok(\@values);
}

# `flatten` takes a list of Result like `([T1,E1], [T2,E2], [T3,E3])` and returns a new Result like ((T1,E1), (T2,E2), (T3,E3)).
sub flatten {
    map { ref $_ && ref $_ eq 'ARRAY' ? @$_ : $_ } @_;
}

# `match` takes two coderefs for on success and on failure, and returns a new function.
sub match {
    my ($on_success, $on_failure) = @_;

    if (CHECK_ENABLED) {
        croak "`match` arguments must be two coderefs for on success and on error" unless _is_callable($on_success) && _is_callable($on_failure);
    }

    my $match = sub {
        my ($value, $err) = @_;

        if (CHECK_ENABLED) {
            croak "`match` function arguments must be result like (T, E)" unless @_ == 2;
        }

        if ($err) {
            return $on_failure->($err);
        } else {
            return $on_success->($value);
        }
    };

    my $package = caller(0);
    my $fullname = "$package\::__MATCHER_FUNCTION__";
    Sub::Util::set_subname($fullname, $match);

    return $match;
}

# `unsafe_nwrap` takes a Result and returns a T when the result is an Ok, otherwise it throws exception.
# It should be used in tests or debugging code.
sub unsafe_unwrap {
    my ($value, $err) = @_;
    if ($err) {
        croak "Error called in `unsafe_unwrap`: @{[ _ddf($err) ]}"
    }
    return $value;
}

# `unsafe_unwrap_err` takes a Result and returns an E when the result is an Err, otherwise it throws exception.
# It should be used in tests or debugging code.
sub unsafe_unwrap_err {
    my ($value, $err) = @_;
    if (!$err) {
        croak "No error called in `unsafe_unwrap_err`: @{[ _ddf($value) ]}"
    }
    return $err;
}

# Dump data for debugging.
sub _ddf {
    my $v = shift;

    no warnings 'once';
    require Data::Dumper;
    local $Data::Dumper::Indent   = 0;
    local $Data::Dumper::Useqq    = 0;
    local $Data::Dumper::Terse    = 1;
    local $Data::Dumper::Sortkeys = 1;
    local $Data::Dumper::Maxdepth = 2;
    Data::Dumper::Dumper($v);
}

# Check if the argument is a callable.
sub _is_callable {
    my $code = shift;
    (Scalar::Util::reftype($code)||'') eq 'CODE'
}

1;
__END__