PFLANZE / FunctionalPerl-0.72.76 / lib / FP / OrderedCollection.pm 

            

              
1
2
3
4
5
6
7
8
—
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126

              
#
# Copyright (c) 2014-2019 Christian Jaeger, copying@christianjaeger.ch
#
# This is free software, offered under either the same terms as perl 5
# or the terms of the Artistic License version 2 or the terms of the
# MIT License (Expat version). See the file COPYING.md that came
# bundled with this file.
#
=head1 NAME
FP::OrderedCollection
=head1 SYNOPSIS
    use FP::Equal 'is_equal'; use FP::Stream;
    use FP::OrderedCollection;
    my $c = FP::OrderedCollection->new_from_values(qw(a b c f));
    ok $c->contains("a");
    ok not $c->contains("q");
    is $c->maybe_position("1"), undef;
    is $c->maybe_position("f"), 3;
    is_equal [ $c->perhaps_following ("xx")], [];
    is_equal $c->perhaps_following("c"), stream('f');
    is_equal $c->perhaps_following("b"), stream('c', 'f');
    is_equal $c->perhaps_previous("c"), stream('b', 'a');
    is $c->maybe_prev("c"), 'b';
    is $c->maybe_prev("a"), undef;
    is $c->maybe_prev("xx"), undef;
    is $c->maybe_next("a"), 'b';
    is $c->maybe_next("f"), undef;
=head1 DESCRIPTION
=head1 SEE ALSO
Implements: L<FP::Abstract::Pure>
=head1 NOTE
This is alpha software! Read the status section in the package README
or on the L<website|http://functional-perl.org/>.
=cut
package FP::OrderedCollection;
use strict;
use warnings;
use warnings FATAL => 'uninitialized';
use FP::Predicates;
use FP::Stream
    qw(subarray_to_stream subarray_to_stream_reverse  stream_to_array);
use FP::Lazy;
use FP::List;
use FP::Carp;
use FP::Struct [[\&is_array, "array"], [\&is_hash, "hash"]],
    'FP::Abstract::Pure';
# Unsafe: assumes that the given array is never mutated after
# constructing the OrderedCollection
sub unsafe_new_from_array {
    my $cl = shift;
    @_ == 1 or fp_croak_arity 1;
    my ($a) = @_;
    my %h;
    for my $i (0 .. $#$a) {
        $h{ $$a[$i] } = $i;
    }
    $cl->new($a, \%h)
}
sub new_from_array {
    my $cl = shift;
    @_ == 1 or fp_croak_arity 1;
    my ($a) = @_;
    $cl->unsafe_new_from_array([@$a])
}
sub new_from_values {
    my $cl = shift;
    $cl->unsafe_new_from_array([@_])
}
sub contains {
    my $s = shift;
    @_ == 1 or fp_croak_arity 1;
    exists $$s{hash}{ $_[0] }
}
sub maybe_position {
    my $s = shift;
    @_ == 1 or fp_croak_arity 1;
    $$s{hash}{ $_[0] }
}
sub perhaps_following {
    my $s = shift;
    my $i = $s->maybe_position(@_) // return;
    subarray_to_stream($$s{array}, $i + 1)
}
sub perhaps_previous {
    my $s = shift;
    my $i = $s->maybe_position(@_) // return;
    subarray_to_stream_reverse($$s{array}, $i - 1)
}
sub maybe_next {
    my $s = shift;
    my ($l) = $s->perhaps_following(@_) or return undef;
    $l = force($l);
    is_null($l) ? undef : car $l
}
sub maybe_prev {
    my $s = shift;
    my ($l) = $s->perhaps_previous(@_) or return undef;
    $l = force($l);
    is_null($l) ? undef : car $l
}
_END_