package Evo::Manager;
use Evo::Base 'Railway::Builder';
use Evo::Util;
use Evo::Wrappers;

has way_class   => sub { require Evo::Way;   'Evo::Way'; };
has train_class => sub { require Evo::Train; 'Evo::Train'; };

# don't try to use this as attr, it'll cause a leak
sub default_curry ($self) {
  $self->curry_wrappers(Evo::Wrappers::w_dsl_init());
}

sub build_way($self,%args) {
  $args{curry} //= $self->default_curry;
  $self->SUPER::build_way(%args);
}

# return current, or value by key
# if not exists, return false without error
sub check_current($self, $key=undef) {
  my $cur = $self->singleton->{CURRENT} or return;
  $key ? exists $cur->{$key} : $cur;
}

sub current { Evo::Util::_current('CURRENT', shift->singleton, @_) }

sub _call {
  my ($self, $cb) = (shift, pop);
  my $single = $self->singleton;

  do { $self->{dsl_depth}++; $single->{dsl_global_depth}++ };

  Evo::Util::_guard { $self->{dsl_depth}--; $single->{dsl_global_depth}--; }
  sub { $cb->() };


}
sub dsl_depth { $_[0]->{dsl_depth} //= 0 }
sub dsl_global_depth { $_[0]->singleton->{dsl_global_depth} //= 0 }

# extend current for next cb. shoult die on existing keys
sub dsl_extend {
  my ($self, $cb) = (shift, pop);
  my $extend  = shift // Carp::croak 'provide extend hashref';
  my @args    = @_;
  my $current = {$self->current->%*};

  local $self->singleton->{CURRENT} = $current;
  $self->current($_ => $extend->{$_}) for keys %$extend;
  $self->_call(sub { $cb->(@args) });
}

# initialize dsl
sub dsl_call {
  my ($self, $cb) = (shift, pop);
  local $self->singleton->{CURRENT} = shift // {};
  my @args = @_;

  $self->_call(sub { $cb->(@args) });
}

sub run_wrappers { Evo::Util::run_wrappers(@_) }

# $station = run_wrappers(@left_wrappers)->(@right_wrappers, $cb);
sub curry_wrappers($self, @left) {
  sub(@right) { $self->run_wrappers(@left, @right) }
}

sub singleton($class,@args) {
  state $single = (ref $class || $class)->new(@args);
}

1;

# ABSTRACT: Perl Evo manager

__END__

=pod

=encoding UTF-8

=head1 NAME

Evo::Manager - Perl Evo manager

=head1 VERSION

version 0.009

=head1 SYNOPSIS

  use Evo::Base -strict;
  use Evo::Manager;
  use Evo::Wrappers 'w_dsl_init';
  my $mngr  = Evo::Manager->new;
  my $way   = $mngr->build_way;
  my $train = $mngr->build_train(way => $way);

  my $curry = $mngr->curry_wrappers(w_dsl_init);
  $curry->(sub { say keys $mngr->current->%* })->($mngr->build_train);

  my @args = qw(1 2);
  my $stash = {foo => 'bar'};
  $mngr->dsl_call($stash, @args, sub { say $mngr->current('foo'); say @_ });

  # see more example in Evo.pm docs

=head1 DESCRIPTION

Your can consider a manager as a builder + organazer.
That was made to make a usage simple. This class subclasses
L<Railway::Builder> and provide a glue to make features working
together with a less typing.

=head1 METHODS

=head2 default_curry

A default curry function, bassed to L<Evo::Way> instances. Dont't make this
as an attribute while subclassing, unless you are sure what you want

=head2 check_current

  my $context = $mngr->check_current;
  my $exists  = $mngr->check_current('key');

Safely check a current context without throwing an extention.

=head2 current

Work with current context

  # get all context
  my $current = $mngr->current;

  # get value by key
  my $val = $mngr->current('key');

  # set value once
  $mngr->current('new' => 'val')->current('new');

Thows an error when is called outside dsl. Throws an error if key doesn't exist
Throws an error on attempts to override existing key. You can also use
L</"check_current"> or as hash referrence, but in most
cases if you get an error, you're doing something wrong.

=head2 dsl_call

Invoke a callback with dsl. First argument is L</"current"> context,
last is a code referrence, others will be passed as arguments

  $mngr->dsl_call({}, 1, 2, sub { });
  $mngr->dsl_call({foo => 2}, sub { say $mngr->current('foo') });

=head2 dsl_extend (Experimental)

  $mngr->dsl_call(
    {foo => 2},
    sub {
      local $, = '; ';
      say keys $mngr->current->%*;
      $mngr->dsl_extend({bar => 3}, sub { say keys $mngr->current->%*; });
      say keys $mngr->current->%*;
    }
  );

Extends current dsl with keys from first argument for invocation of the last
one. Others will be passed as arguments. You still can'not override existing
keys. Thows an expection outside dsl

=head2 run_wrappers

  my $wrapped =  $mngr->run_wrappers(@wrappers, $cb);

Run wrappers for a callback in reverse order. Wrappers are higher-order
functions. See an examples in synopsis or L<Evo::Wrappers/"w_dsl_init">
Or wait for an article

Returns a last argument, if it is the only one and no wrappers provided

=head2 curry_wrappers

  my $curry   = $mngr->curry_wrappers(@wrappers);
  my $curried = $curry->($cb);
  $curried->();

  my @extra_wrappers;
  $curry->(@extra_wrappers, $cb)->();

Creates a curry function for wrappers, that invokes L</"run_wrappers">
with given list + passed arguments.

=head2 singleton
Singleton - the same instance will be returned for every invocation

  my $single = Evo::Manager->singleton;  

=head2 dsl_depth

  A depth of recurcive L</"dsl_call"> or L</"dsl_extend"> invocations by
  instance. C<0> means we are not in the dsl

=head2 dsl_global_depth

  The same as L</"dsl_depth"> but calculates all invocations of all instances.

=head1 ATTENTION

Curry isn't a real currying function, it's a partial function. But I have no
idea how to name it. So it's a subject to change in the future (and all relayed
attributes)

=build_way

Builds a L<Evo::Way> instance passing a result of invocation L</"default_curry">
to it as a L<Evo::Way/"curry"> attribute.

=head1 AUTHOR

alexbyk.com

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by alexbyk.

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

=cut
