Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Some small tweaks to Red. #404

Open
wants to merge 8 commits into
base: master
Choose a base branch
from
4 changes: 4 additions & 0 deletions lib/MetamodelX/Red/Model.pm6
Original file line number Diff line number Diff line change
Expand Up @@ -81,6 +81,10 @@ method columns(|) is rw {
@!columns
}

method column-values (\model --> Hash) {
%(@!columns.map: { %!attr-to-column{.name} => .get_value(model) });
}

#| Returns a hash with the migration hash
method migration-hash(\model --> Hash()) {
columns => @!columns>>.column>>.migration-hash,
Expand Down
20 changes: 20 additions & 0 deletions lib/Red/Driver/Pg.pm6
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,22 @@ multi method translate(Red::AST::Select $_, $context?, :$gambi where !*.defined)
self.Red::Driver::CommonSQL::translate($_, $context, :gambi);
}

multi method translate(Red::AST::In $_, $context?) {
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Isn't it common? Couldn't it be on CommonSQL?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's common, But It's strange that it works in SQLite.

if .right.value ~~ Positional {
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Could you, please, put this test on the signature and remove the else?

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I mean something like:

multi method translate(Red::AST::In $_ where .right.value ~~ Positional, $context?) {

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

But, instead of testing the right's value type, it would be better to test if it's an Red::AST::Value and if its .type is Positional.

multi method translate(Red::AST::In $_ where .right ~~ Red::AST::Value && .right.type ~~ Positional, $context?) {

my ($lstr, @lbind) := do given self.translate: .left, $context { .key, .value }

if .right.value.elems == 0 {
return "$lstr { .op } (SELECT 0 WHERE false)" => @lbind;
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why change to use in (SELECT 0 WHERE false)? why not in ()?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Because In Pg, the in () will raise error, So, we should add placehoder statement to select "nothing".

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

In that way, maybe we could do an:

multi method translate(Red::AST::In $_ where .right ~~ Red::AST::Value && .right.type ~~ Positional && .right.elems, $context?) {

?

}

my $in-placeholder = '(' ~ (self.wildcard xx .right.value.elems).join(',') ~ ')';
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If you fix one of my errors (https://github.com/FCO/Red/blob/master/lib/Red/Driver/CommonSQL.pm6#L521) changing "?" to self.wildcard, you could just use the self.translate: .right, $context


return "$lstr { .op } $in-placeholder" => [|@lbind, |.right.value];
} else {
nextsame;
}
}

multi method translate(Red::AST::RowId $_, $context?) { "OID" => [] }

multi method translate(Red::AST::Delete $_, $context?, :$gambi where !*.defined) {
Expand Down Expand Up @@ -111,6 +127,10 @@ multi method default-type-for(Red::Column $ where .attr.type ~~ Bool
multi method default-type-for(Red::Column $ where .attr.type ~~ UUID --> Str:D) {"uuid"}
multi method default-type-for(Red::Column $ --> Str:D) {"varchar(255)"}

multi method type-by-name("text" --> "text") {}
multi method type-by-name("json" --> "json") {}
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Could you, please, add a test for json and jsonb?

multi method type-by-name("jsonb" --> "jsonb") {}

multi method inflate(Str $value, DateTime :$to!) { DateTime.new: $value }

multi method map-exception(DB::Pg::Error::FatalError $x where .?message ~~ /"duplicate key value violates unique constraint " \"$<field>=(\w+)\"/) {
Expand Down
48 changes: 48 additions & 0 deletions t/20-in-pg.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,48 @@
use Red;
use Test;

my $*RED-PG-TEST-DB = $_ with %*ENV<RED_PG_TEST_DB>;

my $*RED-DEBUG = $_ with %*ENV<RED_DEBUG>;
my $*RED-DEBUG-AST = $_ with %*ENV<RED_DEBUG_AST>;

plan 2;
unless $*RED-PG-TEST-DB {
"No RED_PG_TEST_DB initialized.".say;
skip-rest 2;
}

model Category is table<test_category> {
has Int $.id is serial;
has Int $.parent_id is column{ :references{ Category.id }, :nullable, };
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This test is failing here. For Red:api<2> you need to set the :model<> for is referencing or :model-name<> in this case... and receive the model type as parameter:

has Int $.parent_if is column{ :references{ .id }, :nullable };

has Str $.name is column;

has Category $.parent is relationship{ .parent_id };
has Category @.children is relationship{ .parent_id };
}

$GLOBAL::RED-DB = database "Pg", :dbname($*RED-PG-TEST-DB);

Category.^create-table;

my $parent = Category.^create: :name('xx');

for [1 .. 5] -> $x {
Category.^create: :parent_id($parent.id), :name("child-$x");
}

# # This worked.
# (Category.^rs.grep: { .id (<) Category.^all.grep({ .id == 3 }).map({ .id }) } ).Seq.perl.say;

# # This doesn't.
# (Category.^rs.grep: { .id (<) $parent.children.map({ .id }) } ).Seq.perl.say;



# This worked in SQLite (But doesn't work with Pg driver.)
# my $*RED-DEBUG-AST = True;
my @seq = $parent.children.map({ .id }).Seq.sort;

is-deeply @seq, [Category.^rs.grep({ .id in @seq }).map(*.id).Seq.sort], "in with literal list for pg";
is-deeply @seq, [Category.^rs.grep({ .id (<) @seq }).map(*.id).Seq.sort], "in with literal list for pg (<) operator";