#
# Copyright (c) 2015 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::DBI - DBI with results as lazy lists

=head1 SYNOPSIS

    use FP::DBI;

    $dbh = FP::DBI->connect($data_source, $username, $auth, \%attr);

    # same as `DBI`:
    ..
    $sth = $dbh->prepare($statement);
    ..
    $rv = $sth->execute;

    # then:
    my $s = $sth->row_stream;    # purearrays blessed to FP::DBI::Row
    # or
    #my $s = $sth->array_stream; # arrays
    # or
    #my $s = $sth->hash_stream;  # hashes

    use PXML::XHTML;
    TABLE
      (TH($s->first->map (\&TD)),
       $s->rest->take (10)->map (sub {TR($_[0]->map (\&TD))}))

=head1 DESCRIPTION

Get rows as items in a lazy linked list (functional stream).

NOTE: `DBI` is designed so that when running another `execute` on the
same statement handle, fetching returns rows for the new execute; this
means, a new execute makes it impossible to retrieve further results
from the previous one. Thus if a result stream isn't fully used before
a new `execute` or a different result request is being made, then the
original stream can't be further evaluated anymore; to prevent this
from happening, an interlock mechanism is built in that throws an
error in this case.


=head1 SEE ALSO

L<DBI>, L<FP::Stream>

=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::DBI;

use strict;
use warnings;
use warnings FATAL => 'uninitialized';

use DBI;
use Chj::TEST;

use Chj::NamespaceCleanAbove;

{

    package FP::DBI::db;
    our @ISA = 'DBI::db';

    sub prepare {
        my $s  = shift;
        my $st = $s->SUPER::prepare(@_);
        bless $st, "FP::DBI::st"
    }
}

{

    package FP::DBI::Row;
    use FP::PureArray();    # XX oh, ugly, to load the below namespace!
    use base 'FP::_::PureArray';
}

{

    package FP::DBI::st;
    our @ISA = 'DBI::st';
    use FP::Lazy;
    use FP::Weak;
    use FP::List;

    sub make_X_stream {
        my ($method, $maybe_mapfn) = @_;
        sub {
            my $s  = shift;
            my $id = ++$$s{private_fp__dbi__id};
            my $lp;
            $lp = sub {
                my $lp = $lp;    #keep strong reference
                lazy {
                    $$s{private_fp__dbi__id} == $id
                        or die("stream was interrupted by another execute"
                            . " or stream request");
                    if (my $v = $s->$method) {
                        cons($maybe_mapfn ? &$maybe_mapfn($v) : $v, &$lp);
                    } else {
                        null
                    }
                }
            };
            Weakened($lp)->()
        }
    }

    use Chj::NamespaceCleanAbove;

    sub execute {
        my $s = shift;
        $$s{private_fp__dbi__id}++;
        $s->SUPER::execute(@_)
    }

    *row_stream = make_X_stream(
        "fetchrow_arrayref",
        sub {
            bless([@{ $_[0] }], "FP::DBI::Row")
        }
    );
    *array_stream = make_X_stream("fetchrow_arrayref");
    *hash_stream  = make_X_stream("fetchrow_hashref");

    _END_
}

use base 'DBI';

sub connect {
    my $cl = shift;
    my $v  = $cl->SUPER::connect(@_);
    bless $v, "FP::DBI::db"
}

_END_    # namespace cleaning