=head1 NAME

cf::match - object matching language

=head1 DESCRIPTION

This module implements a simple object matching language. It can be asked
to find any (boolean context), or all (list context), matching objects.

=head1 MATCH EXAMPLES

Match the object if it has a slaying field of C<key1>:

   slaying = "key1"

Match the object if it has an object with name C<force> and 
slaying C<poison> in it's inventory:

   has (name = "force" and slaying = "poison")

Find all inventory objects with value >= 10, which are not invisible:

   value >= 10 and not invisible in inv

Find all potions with spell objects inside them in someones inventory:

   type=SPELL in type=POTION in inv

Find all potions inside someones inventory, or inside applied containers:

   type=POTION also in type=CONTAINER and applied in inv

=head1 LANGUAGE

   # object selection

   select   = set
            | select also rep 'in' set
   also     = nothing | 'also'
   rep      = nothing | 'rep' | 'repeatedly'

   set      = 'inv' | 'env' | 'map'

   empty    =

   # object matching

   match    = factor
            | factor 'and'? match
            | factor 'or'   match

   factor   = 'not' factor
            | '(' match ')'
            | expr
            | expr operator constant

   operator = '=' | '==' | '!=' | '<' | '<=' | '>' | '>='

   expr     = flag
            | sattr
            | aattr '[' <constant> ']'
            | special
            | func '(' args ')'
            | '{' perl code block '}'

   func     = <any function name>
   sattr    = <any scalar object attribute>
   aattr    = <any array object attribute>
   flag     = <any object flag>
   special  = <any ()-less "function">

   constant = <number> | '"' <string> '"' | <uppercase cf::XXX name>
   args     = <depends on function>

   TODO: repeatedly, env, contains, possbly matches

=head2 STRUCTURE

The two main structures are the C<select>, which selects objects matching
various criteria, and the C<match>, which determines if an object matches
some desired properties.

A C<select> is passed a set of "context objects" that it is applied
to. This is initially just one object - for altars, it is the object
dropped on it, for pedestals, the object on top of it and so on.

This set of context objects can be modified in various ways, for example
by replacing it with the inventories of all objects, or all objects on the
same mapspace, and so on, by using the C<in> operator.

Once the set of context objects has been established, each object is
matched against the C<match> expression. Sometimes the server is only
interested in knowing whether I<anything> matches, and sometimes the
server is interested in I<all> objects that match.

=head2 OPERATORS

=over 4

=item and, or, not, ()

Match expressions can be combined with C<and> or C<or> to build larger
expressions. C<not> negates the expression, and parentheses can be used to
group match expressions.

Example: match applied weapons.

   type=WEAPON and applied

Example: match horns or rods.

   type=HORN or type=ROD

=item in ...

The in operator takes the context set and modifies it in various ways.

=over 4

=item in inv

Replaces all objects by their inventory.

Example: find all spell objects inside the object to be matched.

   type=SPELL in inv

=item in env

Replaces all objects by their containing object, if they have one.

=item in map

Replaces all objects by the objects that are on the same mapspace as them.

=item in <match>

Finds all context objects matching the match expression, and then puts
their inventories into the context set.

Note that C<in inv> is simply a special case of an C<< in <match> >> that
matches any object.

Example: find all spells inside potions inside the inventory of the context
object(s).

   type=SPELL in type=POTION in inv

=item also in ...

Instead of replacing the context set with something new, the new objects
are added to the existing set.

Example: check if the context object I<is> a spell, or I<contains> a spell.

   type=SPELL also in inv

=item repeatedly in ...

Repeats the operation as many times as possible. This can be used to
recursively look into objects.

=item also repeatedly in ...

C<also> and C<repeatedly> can be combined.

Example: check if there are any unpaid items in an inventory,
or in the inventories of the inventory objects, and so on.

   unpaid also repeatedly in inv

Example: check if a object is inside a player.

   type=PLAYER also repeatedly in env

=back

=back

=head2 EXPRESSIONS

Match expressions usually consist of simple boolean checks (flag XYZ is
set) or simple comparisons.

=over 4

=item flags

Flag names (without the leading C<FLAG_>) can be used as-is, in which case
their corresponding flag value is used.

=item scalar object attributes

Object attributes that consist of a single value (C<name>, C<title>,
C<value> and so on) can be specified by simply using their name, in which
acse their corresponding value is used.

=item array objects attributes

The C<resist> array can be accessed by specifying C<< resist [ ATNR_type ]
>>.

Example: match an acid resistance higher than 30.

   resist[ATNR_ACID] > 30

=item functions

Some additional functions with or without arguments in parentheses are
available.

=item { BLOCK }

You can specify perl code to execute by putting it inside curly
braces. The last expression evaluated inside will become the result.

=item comparisons, <, <=, ==, =, !=, =>, >

You can compare expressions against constants via any of these
operators. If the constant is a string, then a string compare will be
done, otherwise a numerical comparison is used.

Example: match an object with name "schnops" that has a value >= 10.

   name="schnops" and value >= 10

=item uppercase constant names

Any uppercase word that exists as constant inside the C<cf::> namespace
(that is, any deliantra constant) can also be used as-is, but needs to be
specified in uppercase.

Example: match a type of POTION (using C<cf::POTION>).

   type=POTION

=back

=head2 FUNCTIONS

=over 4

=item any

This simply evaluates to true, and simply makes matching I<any> object a
bit easier to read.

=item has(match)

True iff the object has a matching inventory object.

=item count(select)

Number of matching objects - the context object for the C<select> are the
original context objects for the overall C<select>. # TODO bullshit

=back

=cut


package cf::match;

use common::sense;

use List::Util ();

# parser state
#   $_    # string to be parsed
our $all; # find all, or just the first matching object

{
   package cf::match::exec;

   our @ctx; # root object(s)

   use List::Util qw(first);

   sub env_chain {
      my @res;
      push @res, $_
         while $_ = $_->env;
      @res
   }

   package cf::match::parser;

   use common::sense;

   sub ws {
      /\G\s+/gc;
   }

   our %func = (
      has => sub {
         'first { ' . &match . ' } $_->inv'
      },
      count => sub {
         local $all = 1;
         '(scalar ' . &select . ')'
      },
   );

   our %special = (
      any => sub {
         1
      },
   );

   sub constant {
      ws;

      return $1       if /\G([\-\+0-9\.]+)/gc;
      return "cf::$1" if /\G([A-Z0-9_]+)/gc;

      #TODO better string parsing, also include ''
      return $1       if /\G("[^"]+")/gc;

      die "number, string or uppercase constant name expected\n";
   }

   our $flag  = $cf::REFLECT{object}{flags};
   our $sattr = $cf::REFLECT{object}{scalars};
   our $aattr = $cf::REFLECT{object}{arrays};

   sub expr {
      # ws done by factor
      my $res;

      if (/\G ( \{ (?: (?> [^{}]+ ) | (?-1) )* \} ) /gcx) {
         # perl

         my $expr = $1;

         $res .= $expr =~ /\{([^;]+)\}/ ? $1 : "do $expr";

      } elsif (/\G([A-Za-z0-9_]+)/gc) {

         if (my $func = $func{$1}) {
            /\G\s*\(/gc
               or die "'(' expected after function name\n";

            $res .= $func->();

            /\G\s*\)/gc
               or die "')' expected after function arguments\n";

         } elsif (my $func = $special{$1}) {
            $res .= $func->();

         } elsif (exists $flag->{lc $1}) {
            $res .= "\$_->flag (cf::FLAG_\U$1)";

         } elsif (exists $sattr->{$1}) {
            $res .= "\$_->$1";

         } elsif (exists $aattr->{$1}) {

            $res .= "\$_->$1";

            /\G\s*\[/gc
               or die "'[' expected after array name\n";

            $res .= "(" . constant . ")";

            /\G\s*\]/gc
               or die "']' expected after array index\n";

         } else {
            $res .= constant;
         }

      } else {
         die "expr expected\n";
      }

      $res
   }

   our %stringop = (
      "==" => "eq",
      "!=" => "ne",
      "<=" => "le",
      ">=" => "ge",
      "<"  => "lt",
      ">"  => "gt",
   );

   sub factor {
      ws;

      my $res;

      if (/\Gnot\b\s*/gc) {
         $res .= "!";
      }

      if (/\G\(/gc) {
         # ()
         $res .= &match;
         ws;
         /\G\)/gc or die "')' expected\n";

      } else {
         my $expr = expr;

         $res .= $expr;

         if (/\G\s*([=!<>]=?)/gc) {
            my $op = $1;

            $op = "==" if $op eq "=";
            my $const = constant;
            $op = $stringop{$op} if $const =~ /^"/;

            $res .= " $op $const";
         }
      }

      "($res)"
   }

   sub match {
      my $res = factor;

      while () {
         ws;
         if (/\G(?=also\b|in\b|\)|$)/gc) {
            # early stop => faster and requires no backtracking
            last;
         } elsif (/\Gor\b/gc) {
            $res .= " || ";
         } else {
            /\Gand\b/gc;
            $res .= " && ";
         }
         $res .= factor;
      }

      $res
   }

   sub select {
      my $res;

      my $also; # undef means first iteration
      while () {
         if (/\G\s*(inv|env|map)\b/gc) {
            if ($1 eq "inv") {
               $res .= " map+(${also}\$_->inv),";
            } elsif ($1 eq "env") {
               $res .= " map+(${also}env_chain), "; # TODO
            } elsif ($1 eq "map") {
               $res .= " map+(${also}\$_->map->at (\$_->x, \$_->y)),";
            }
            last unless /\G\s*in\b/gc;
         } else {
            $res .= " map+($also\$_->inv)," if defined $also;
            $res .= $all ? " grep { " : " first {";
            $res .= match;
            $res .= "}";

            $also = /\G\s*also\b/gc ? '$_, ' : '';
            last unless /\G\s*in\b/gc;
         }
      }

      "$res \@ctx"
   }

}

sub parse($;$) {
   local $_   = shift;
   local $all = shift;

   my $res = "package cf::match::exec;\n"
           .  eval { cf::match::parser::select };

   if ($@) {
      my $ctx = 20;
      my $str = substr $_, (List::Util::max 0, (pos) - $ctx), $ctx * 2;
      substr $str, (List::Util::min $ctx, pos), 0, "<-- HERE -->";

      chomp $@;
      die "$@ ($str)\n";
   }

   $res
}

if (0) {
   my $perl = parse 'flag(SEE_IN_DARK) in inv', 0;

   warn $perl, "\n";#d#
   $perl = eval "no warnings; no feature; sub { $perl }"; die if $@;
   use B::Deparse;
   warn  B::Deparse->new->coderef2text ($perl);
   exit 0;
}

1;