view release on metacpan or  search on metacpan

t/1061-util-valid-hof.t  view on Meta::CPAN

subtest 'always - constant function' => sub {
    my $always_42 = always(42);
    is($always_42->(), 42, 'always: returns constant');
    is($always_42->(1, 2, 3), 42, 'always: ignores args');
    is($always_42->("any", "thing"), 42, 'always: still ignores args');

    my $always_ref = always({ key => 'value' });
    is_deeply($always_ref->(), { key => 'value' }, 'always: works with refs');
};

subtest 'identity - pass-through' => sub {
    is(identity(42), 42, 'identity: number');
    is(identity("hello"), "hello", 'identity: string');
    is(identity(undef), undef, 'identity: undef');

    my $ref = [1, 2, 3];
    is(identity($ref), $ref, 'identity: same ref');
};

subtest 'noop - do nothing' => sub {
    my $result = noop();
    ok(!defined $result, 'noop: returns nothing');

    $result = noop(1, 2, 3, 4, 5);
    ok(!defined $result, 'noop: ignores all args');
};

subtest 'combined workflows' => sub {
    # Build a data processing pipeline with memoization
    my $expensive = memo(sub { $_[0] ** 2 });
    my $process = compose(
        sub { $_[0] + 1 },
        $expensive
    );

    is($process->(5), 26, 'combined: (5^2)+1 = 26');

    # Predicate combination
    my $is_positive = sub { $_[0] > 0 };
    my $is_even = sub { $_[0] % 2 == 0 };
    my $is_non_positive = negate($is_positive);

    ok($is_positive->(5), 'positive check');
    ok($is_non_positive->(-5), 'negated positive check');

    # Using partial with pipeline
    my $add = sub { $_[0] + $_[1] };
    my $add10 = partial($add, 10);
    my $add20 = partial($add, 20);

    is(pipeline(5, $add10, $add20), 35, 'partial in pipeline: 5+10+20');
};

subtest 'real-world use case: validation chain' => sub {
    # Build validators using HOFs
    my $not_empty = sub { defined $_[0] && length($_[0]) > 0 };
    my $max_len = sub { my $max = $_[0]; sub { length($_[0]) <= $max } };
    my $min_len = sub { my $min = $_[0]; sub { length($_[0]) >= $min } };

    my $validate_username = sub {
        my $val = $_[0];
        return 0 unless $not_empty->($val);
        return 0 unless $min_len->(3)->($val);
        return 0 unless $max_len->(20)->($val);
        return 1;
    };

    ok($validate_username->("alice"), 'valid username');
    ok(!$validate_username->("ab"), 'too short');
    ok(!$validate_username->("a" x 25), 'too long');
    ok(!$validate_username->(""), 'empty');
};

subtest 'real-world use case: retry logic' => sub {
    my $attempts = 0;
    my $fail_twice = sub {
        $attempts++;
        die "fail" if $attempts <= 2;
        return "success";
    };

    # Memoize to cache successful result
    my $cached_op = memo(sub {
        my $result;
        for (1..3) {
            eval { $result = $fail_twice->() };
            return $result if defined $result;
        }
        return undef;
    });

    is($cached_op->(), "success", 'retry succeeds');
    is($attempts, 3, 'tried 3 times');

    # Second call uses cache
    $attempts = 0;
    is($cached_op->(), "success", 'cached result');
    is($attempts, 0, 'no new attempts');
};

done_testing();