package Text::Wigwam::Library::Procedure;

    use strict;
    use warnings;
    no warnings q/recursion/;
    our $VERSION = '0.01';

    use base q/Exporter/;

    use Text::Wigwam::Const(
      qw/
        VAR NUM STRING 
        ANY CODE BLESSED
        ARRAY HASH EXPR
        OPTIONAL RUNONCE VOID
      /
    );

    use Text::Wigwam::Library::Utility::Locals;

    our %EXPORT_TAGS = (
        all => [ qw /
            _proto_argc       _argc
            _proto_args       _args
            _proto_argv       _argv
            _proto_init      _init
            _proto_call       _call
            _proto_emulate    _emulate
            _proto_exit       _exit
            _proto_public     _public
            _proto_export     _export
            _proto_expr       _expr
            _proto_include    _include
            _proto_macro      _macro
            _proto_proc       _proc
            _proto_process    _process
            _proto_return     _return
            _proto_stop       _stop
            _proto_template   _template
            _proto_use        _use
            _proto_emulate    _emulate
        / ],
        argc     => [ qw/ _proto_argc     _argc / ],
        args     => [ qw/ _proto_args     _args / ],
        argv     => [ qw/ _proto_argv     _argv / ],
        init     => [ qw/ _proto_init    _init / ],
        call     => [ qw/ _proto_call     _call / ],
        emulate  => [ qw/ _proto_emulate  _emulate / ],
        exit     => [ qw/ _proto_exit     _exit / ],
        export   => [ qw/ _proto_export   _export / ],
        public   => [ qw/ _proto_public   _public / ],
        expr     => [ qw/ _proto_expr     _expr / ],
        include  => [ qw/ _proto_include  _include / ],
        macro    => [ qw/ _proto_macro    _macro / ],
        proc     => [ qw/ _proto_proc     _proc / ],
        process  => [ qw/ _proto_process  _process / ],
        return   => [ qw/ _proto_return   _return / ],
        stop     => [ qw/ _proto_stop     _stop / ],
        template => [ qw/ _proto_template _template / ],
        use      => [ qw/ _proto_use      _use / ],
    );
    our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
    our @EXPORT = qw( );

=head1 Name

Text::Wigwam::Library::Procedure - A Wigwam directive library.

=head1 Description

This library provides directives which introduce procedural capabilities.

=head1 Usage

The directives within this library can be imported into specific branches of
the directive tree (which transcends from  C<Text::Wigwam::Directives>) via
plug-ins or modules using one of the following techniques.

 package Text::Wigwam::Directives::some::arbitrary::branch;
 # import everything
 use Text::Wigwam::Library::Procedure( q/:all/ );
 use Text::Wigwam::Help;

 package Text::Wigwam::Directives::another::arbitrary::branch;
 # import selectively
 use Text::Wigwam::Library::Procedure(
   qw /
    :argc :args :argv
    :init :call :exit :expr
    :include :macro :proc :process
    :return :template :use
   /
 );

=head1 Directives

=cut

sub _proto_argc { [ ] }
sub _argc {
    my ($Api) = @_;
    my $Args = $Api->get_global(q/args/) || [];
    return scalar @$Args if $Api->is_list($Args);
    return scalar keys %$Args;
}

=head2 #argc

Returns the number of arguments available on the argument stack.

 [!!
  #macro foo { #argc }
  #call foo < a b c >
  /* output: 3 */
 !!]

=cut

sub _proto_args { [ ] }
sub _args { return $_[0]->get_global(q/args/) || [] }

=head2 #args

Returns the argument stack, which is typically an array or a hash. You may
alternatively access the same value via the C<:args> global variable.

=cut

sub _proto_argv { [ STRING ] }
sub _argv {
    my ($Api) = @_;
    my $Args = $Api->get_global(q/args/) || [];
    my $key = $Api->get_arg;

     # Return an ordered list value
    return $Args->[$key] if $Api->is_list($Args);

     # Return a named parameter value

     # Find an exact match
    return $Args->{$key} if exists $Args->{$key};
     # else, find a match ignoring case
    my %hmap = map { ( uc $_, $Args->{$_} ) } keys %$Args;
    return $hmap{uc $key};
}

=head2 #argv I<key>

Returns a single value from the argument stack specified by I<key>.

 [!!
  #call #expr {
    #argv 1
    #argv 2
    #argv 0
  } < A B C > /* Output: BCA */
 
  #call #expr {
    #argv 'B'
    #argv 'C'
    #argv 'A'
  } %< A 'Aye' B 'Bee' C 'Cee' > /* Output: BeeCeeAye */
 !!]

Note that, alternatively, you could do the same thing via the global C<:args>
variable.

 [!!
  #call #expr {
    :args:1
    :args:2
    :args:0
  } < A B C > /* Output: BCA */
 
  #call #expr {
    :args.B
    :args.C
    :args.A
  } %< A 'Aye' B 'Bee' C 'Cee' > /* Output: BeeCeeAye */
 !!]

=cut

sub _proto_init { [ STRING|VOID|RUNONCE ] }
sub _init { $_[0]->get_arg }

=head2 #init I<arg>

Forces I<arg> to evaluate only once for the current template. Subsequent
evaluations are ignored.

 [!!
  #define value 0
  #repeat 3 #init #inc value
  value
  /* Output:
    1
  */
 !!]

The C<#init> directive is most useful when used as a priority directive.
Priority directives are executed before any other directives, so this can be
exploited to allow macros to be defined at the bottom the template.

 [!!
  &foo( 'man chu' )
  ##init {
      #macro foo { :args:0 }
  }
  /* Output:
    man chu
  */
 !!]

=cut

sub _proto_call { [ANY, HASH|ARRAY|OPTIONAL], [qw/Return Locals/] }
sub _call {
    no warnings 'uninitialized';
    my ($Api) = @_;
    my $code = $Api->get_arg;
    my $params = $Api->get_arg;

    return $code->( $Api->is_list($params) ? @$params : %$params )
      if $Api->is_code($code);

    if( $Api->is_expr($code) ){
        my $locals = $Api->set_global(
            Locals => Text::Wigwam::Library::Utility::Locals->new($Api)
        );
        my $data = $code->execute($params);
        $locals->restore($Api);

        return $data;
    }

    $Api->exception(
        (
          $Api->is_blessed($code)
            ? ref($code)." is not a supported executable object."
            : ref($code)
              ? ref($code)." is not a supported executable reference."
              : length($code)
                ?  "Cannot execute a scalar value '$code'"
                :  "Encountered a null string where an executable object "
                   . "or reference was expected."
        )
    ) unless $Api->eflag; # Already in exception mode?
    return;
}

=head2 #call I<expr>|I<code> I<args>

Executes an I<expr> (such as that returned by #macro, #template, #include,
#process or #expr) and passes I<args> as arguments which can be retrieved
from within the EXPR via the C<#argv> or C<#args> directives.

 [!! #macro greet !!>
  Welcome, [!! #argv 0 !!].
 <!!
  #foreach person ( "Frank" "Joel" "Tom" "Clayton" ) #call greet( person )
  /*
   Welcome, Frank.
   Welcome, Joel.
   Welcome, Tom.
   Welcome, Clayton.
  */
 !!]

Alternatively, if the first argument is a code reference, it will be executed
and passed I<args> in dereferenced form as its arguments.

=cut

sub _proto_exit { [ ANY ] }
sub _exit {
    my ($Api) = @_;
    $Api->set_global( Exit => \($Api->get_arg) );
    return;
}

=head2 #exit I<val>

Halts processing of the current template and exits with I<val>.

 [!! #unless Query`defined #exit !!]

=cut

sub _proto_stop { [ ] }
sub _stop { $_[0]->set_global( Stop => 1 ); return }

=head2 #stop

Halts processing of the current template and exits.

 [!! #unless #defined Query.action #stop !!]

=cut

 # EXPERIMENTAL
sub _proto_emulate { [ ARRAY ] }
sub _emulate {
    my ($Api) = @_;
    push ( @Text::Wigwam::Virtual::ISA, @{$Api->get_arg} );
    return;
}

 # EXPERIMENTAL
sub _proto_export { [ VAR, ANY ] }
sub _export {
    my ($Api, undef, $vcontx) = @_;
    my $export = $Api->get_arg;
    my $value = $Api->get_arg;
    my $exports = $Api->exports or do {
        $Api->exception( "Exporting has apparently been frowned upon." );
        return;
    };
    $Api->explicit_set_alias(
        $exports,
        '.',
        $export,
        $value,
    );
#    $exports->{$export} = $value;
    return $value unless $vcontx;
    return;
}

 # EXPERIMENTAL
sub _proto_public { [ VAR, EXPR ] }
sub _public {
    my ($Api, undef, $vcontx) = @_;
    my $public = $Api->get_arg;
    my $value = $Api->get_arg;
    $Api->set_value( $public => $value );
    $Api->explicit_set_alias(
        $Api->exports,
        '.',
        $public,
        $value,
    );
    return $value unless $vcontx;
    return;
}

sub _proto_expr { [ EXPR ] }
sub _expr { $_[0]->get_arg }

=head2 #expr I<arg>

Returns I<arg> as a macro (an EXPR type). Similar to #macro, but provides an
alternative inline method for defining a macro.

 [!! #define greet #expr !!>
  Hello, [!! :args:0 !!].
 <!! 
  #foreach person < Mike Clayton Bobo > #call greet( person )
  /* output:
   Hello, Mike.
   Hello, Clayton.
   Hello, Bobo.
 */
 !!]

=cut

sub _proto_include { [ STRING ] }
sub _include {
    my ($Api) = @_;
    return $Api->spawn( $Api->get_arg );
}

=head2 #include I<filename>

Loads an external template specified by I<filename> and returns it as an EXPR
object which can be assigned to a variable, #call'ed, or executed on the spot.
The external template will execute as if it were a macro defined within the
calling template in that it will share a common varspace and be subject to the
its globals.

 [!! #include "foobar" !!]

=cut

 # EXPERIMENTAL
#sub _proto_new { [ STRING, ARRAY|HASH ], [ qw/Locals Return/ ] }
#sub _new {
#    my ($Api) = @_;
#    my $fname = $Api->get_arg;
#    my $params = $Api->get_arg;
#    my $texpr = $Api->spawn( $Api->get_arg, {} );
#    $texpr->init( $Api->get_arg );
#}
#
#=head2 #new I<filename> I<params> (Experimental)
#
#An experimental directive designed to spawn a template, I<filename>, and
#initialize it (see the C<#new> directive) with a set of parameters,
#I<params>.
#
#=cut

sub _proto_macro { [ VAR, EXPR ] }
sub _macro {
    my ($Api, undef, $vcontx) = @_;
    my $var = $Api->get_arg;
    $Api->set_value( $var, $Api->get_arg );
    return if $vcontx;
    return $var;
}

# PROC is to be deprecated
sub _proto_proc { [ VAR, EXPR ] } 
sub _proc { $_[0]->set_value( $_[0]->get_arg, $_[0]->get_arg ); return }

=head2 #macro I<var> I<block>

Stores I<block> into I<var> for later execution. This I<var> can then be used
as a simple macro which is executed as if it were literally placed there, or
it can be called with parameters as a subroutine via the #call directive.

 [!!
    #macro html_widget.input {
      #parameters < name type value > /* Retrieve parameters */
      !!>
       <Input
         name="[!! name !!]"
         type="[!! type !!]"
         value="[!! value !!]"
       >
      <!!
    }
    #call html_widget.input %<
        name  "bazz"
        type  "text"
        value "Hey!"
    >
  /* output:
   <Input name="bazz" type="text" value="Hey!">
  */
 !!]

=cut

sub _proto_return { [ ANY ] }
sub _return {
     # We store a reference to force the eflag true regardless of its value.
    $_[0]->set_global( Return => \($_[0]->get_arg) );
    return;
}

=head2 #return I<val>

Replaces the text generated from the current #call'ed expression with I<val>
instead, which is then passed on by #call.

 [!!
  #macro foo {
     "This is what would've been returned had we not used #return"
     #return "foo was here!"
     "We never get this far"
  }
  #call foo ()
  /* output:  foo was here! */
 !!]

We can return any data type. The following example returns an array.

 [!!
  #macro foo {
     "This is what would've been returned had we not used #return"
     #return ( "foo was here!" )
  }
  #pop #call foo ()
  /* output: foo was here! */
 !!]

=cut

sub _proto_process { [ STRING, HASH|OPTIONAL ], [qw/Locals Return/] }
sub _process { template($_[0]->get_arg, $_[0]->get_arg,  @_) }

=head2 #process I<filename> I<hash>

Loads an external template specified by I<filename> while using I<hash> as
its varspace. Returns an EXPR object which can be assigned to a variable,
#call'ed, or simply executed where it stands, as below.

 [!! #process "html_header" %< title 'My Title' > !!]

=cut

#sub _proto_template { [ STRING ], [ qw/Locals/ ] }
sub _proto_template { [ STRING ], [ qw/Locals Return/ ] }
sub _template { template($_[0]->get_arg, {},  @_) }

sub template {
    my ($fname, $vspace, $Api, undef, $vcontx) = @_;

    my $texpr = $Api->spawn( $fname, $vspace );
    return $texpr unless $vcontx;

    my $locals = $Api->set_global(
        Locals => Text::Wigwam::Library::Utility::Locals->new($Api)
    );
    my $data = $texpr->execute();
    $locals->restore($Api);

    return $data;
}

=head2 #template I<filename>

Identical to the #process directive except that it requires one less argument
since the template is assigned an anonymous, private varspace hash.

 [!! #template "foobar" !!]
 This is functionally equivalent to:
 [!! #process "foobar"; !!]

=cut

sub _proto_use { [ STRING, ARRAY|HASH|OPTIONAL ] }
sub _use {
    my ($Api, undef, $vcontx) = @_;
    my $pkg = $Api->get_arg;
    my $arr = $Api->get_arg;
    if( my $err = $Api->load_perlmod($pkg) ){
        $Api->exception($err);
        return;
    }
    return $pkg->new(@$arr) unless $vcontx;
    return;
}

=head2 #use I<package> I<args> (EXPERIMENTAL)

Loads and evaluates a Perl library module if it hasn't already been loaded.
Returns nothing when called in void context, otherwise it attempts to call the
package's C<new> constructor while passing it dereferenced I<args> hash or
array as arguments, then returns the result.

 [!!
    /* void context - evaluates foo::bar if necessary, but returns nothing */
   #use "foo::bar";

    /* evaluates foo::bar and executes foo::bar->new( 'baz', 'qux' ) */
   #define fb #use foo::bar ( 'baz' 'qux' )
 !!]

=cut

sub init_lib {
#    $_[0]->new_eflag( TEMPLATE => q/Bail/ );
    $_[0]->new_eflag( TEMPLATE => q/Stop/ );
    $_[0]->new_subst( TEMPLATE => q/Exit/ );
    $_[0]->new_subst( LOCAL    => q/Return/ );
#    $_[0]->new_global( LOCAL   => q/Locals/ );
}

1;
