my ($user, $workhrs0, $geo0, $workhrs1, $geo1) =
  ('NWIGER', '20', 'ASIA', '50', 'EURO');

query  {
  package Table;
  WHERE
    (
     ANDS (
           user == $user,
           ORS (
                ANDS ( workhrs > $workhrs0 , geo == 20 ),
                ORS  ( $workhrs1 < workhrs,  geo == $geo1 )
               )
          )
    );
};

##</code><code>##

=== B::Deparse of the Code: 
{
    package Table;
    use warnings;
    use strict;
    use feature 'say';
    WHERE(ANDS(user() == $user, ORS(ANDS(workhrs() > $workhrs0, geo() == 20), ORS($workhrs1 < workhrs(), geo() == $geo1))));
} at d:/Users/lanx/vm_share/perl/Talks/DSL/2018_GPW/exp/SQL_abstract.pl line 51.


=== Tidy of deparsed Perl-code: 
{

    package Table;
    use warnings;
    use strict;
    use feature 'say';
    WHERE(
        ANDS(
            user() == $user,
            ORS(
                ANDS( workhrs() > $workhrs0, geo() == 20 ),
                ORS( $workhrs1 < workhrs(), geo() == $geo1 )
            )
        )
    );
}


=== Abstract Syntax Tree (simplified): 
  :'WHERE' is ::Clause
    :'ANDS' is ::Joiner
      :'=' is ::Infix
        :'user' is ::Column
        :'NWIGER' is ::Placeholder
["\n        ", "NWIGER"]
      :'ORS' is ::Joiner
        :'ANDS' is ::Joiner
          :'>' is ::Infix
            :'workhrs' is ::Column
            :'20' is ::Placeholder
["\n            ", 20]
          :'=' is ::Infix
            :'geo' is ::Column
            :'20' is SCALAR
        :'ORS' is ::Joiner
          :'<' is ::Infix
            :'50' is ::Placeholder
["\n            ", 50]
            :'workhrs' is ::Column
          :'=' is ::Infix
            :'geo' is ::Column
            :'EURO' is ::Placeholder
["\n            ", "EURO"]


=== Produced SQL: 

   WHERE 
    ( 
       user = ? AND 
      ( 
        ( 
           workhrs > ? AND 
           geo = 20 
        ) OR 
        ( 
           ? < workhrs OR 
           geo = ? 
        ) 
      ) 
    )  at d:/Users/lanx/vm_share/perl/Talks/DSL/2018_GPW/exp/SQL_abstract.pl line 59.

##</code><code>##

package Table;

use strict;
use warnings;
use Data::Dump qw/pp dd/;



sub generator {
  my ($op, $class) = @_;
  sub { bless [$op, @_], $class}
}

sub column { bless [@_], 'Column' }

BEGIN {
    my @clauses   = qw/WHERE/;
    my @joiners   = qw/ANDS ORS/;
    my @columns   = qw/user workhrs geo/;
    use subs @clauses;
    use subs @joiners;
    use subs @columns;
    no strict 'refs';
    *{$_} = generator($_, 'SQL::DSL::Column') for @columns;
    *{$_} = generator($_, 'SQL::DSL::Clause') for @clauses;
    *{$_} = generator($_, 'SQL::DSL::Joiner') for @joiners;
}




package main;
use Data::Dump qw/pp dd/;
use B::Deparse;
use Perl::Tidy;
use feature 'say';
use subs qw/WHERE ANDS ORS/;
use subs qw/LE GE LT GT EQ NE/;
#use constant {user =>1, workhrs=>2, geo=>3};

our $level;

sub query (&) {
    my $code = shift;

    my $query = $code->();
    my $AST = pp $query;
    $AST =~ s/\(\[/[/g;
    $AST =~ s/bless//g;

    warn "\n\n=== B::Deparse of the Code: \n",
      my $text = B::Deparse->new()->coderef2text($code);

    warn "\n\n=== Tidy of deparsed Perl-code: \n";
    Perl::Tidy::perltidy( source      => \$text);

    warn "\n\n=== Abstract Syntax Tree (simplified): \n";
    $level=0;
    warn "\n\n=== Produced SQL: \n",
      walk($query)," ";

}
;



sub walk {
    my $ast = shift;
    local $level= $level+1;
    my $indent = "  "x$level;
    my $ref = ref $ast;
    my @args = ();
    my $token = "";
    if ($ref) {
        @args  = @$ast;
        $token = shift @args;
    } else {
        $token = $ast;
        $ref   = 'SCALAR';
    }

    (my $type=$ref) =~ s/^SQL::DSL//;
    say $indent ,":'$token' is $type";
    #pp \@args;
    my @list;
    for my $part (@args) {
        push @list, walk($part)
    }

    my $rendition;
    if ( my $render = $ref->can("render") ) {
        $rendition = $render->("\n$indent",$token,@list);
    } else {
        my $list = join ",", @list ;
        $rendition = "$token";
        $rendition .= "\n$indent\[ $list \n$indent]" if $list;
    }
    return $rendition;
}




my ($user, $workhrs0, $geo0, $workhrs1, $geo1) =
  ('NWIGER', '20', 'ASIA', '50', 'EURO');

query  {
  package Table;
  WHERE
    (
     ANDS (
           user == $user,
           ORS (
                ANDS ( workhrs > $workhrs0 , geo == 20 ),
                ORS  ( $workhrs1 < workhrs,  geo == $geo1 )
               )
          )
    );
};




package SQL::DSL::Infix;


sub render {
    my ($indent,$op,$left,$right) = @_;
    return "$indent $left $op $right";
}


package SQL::DSL::Joiner;

sub render {
    my ($indent,$op,@list) = @_;
    $op =~s/S$//;
    my $render = join " $op ", @list ;
    return "$indent( $render $indent)";
}




package SQL::DSL::Clause;
use Data::Dump qw/pp dd/;
sub render {
    my ($indent,$op,@list) = @_;
    return "$indent $op @list";
}


package SQL::DSL::Column;
use Data::Dump qw/pp dd/;
use Scalar::Util qw/readonly/;

sub ovl_binop {
    my ($op) = @_;

    return sub {

        for my $operand ( @_[0,1] ) {
            if (not readonly($operand) and not ref $operand) {
                $operand = bless [ $operand], "SQL::DSL::Placeholder";
            }
        }

        my @operands = $_[2] ? @_[1,0] : @_[0,1]; #  check swapflag

        # warn "$op readonly0:$_[0]" if readonly 
        # warn "$op readonly1:$_[1]" if readonly $_[1];

        #pp
          my $obj = bless [ $op ,@operands], "SQL::DSL::Infix";
        return $obj;
    }
}

use overload
  "==" => ovl_binop("="),
  ">"  => ovl_binop(">"),
  "<"  => ovl_binop("<"),
  ;



package SQL::DSL::Placeholder;
use Data::Dump qw/pp dd/;

our @bind_values=();

sub render {
    pp \@_;
    push @bind_values, $_[1];
    return '?';
}