From 7b1420b212b2237f584b2487bcfc5c0169defb15 Mon Sep 17 00:00:00 2001 From: Yiyi Hu Date: Sat, 2 Nov 2019 20:42:10 +0800 Subject: [PATCH 1/6] Add column-values method to MetamodelX::Red::Model --- lib/MetamodelX/Red/Model.pm6 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/MetamodelX/Red/Model.pm6 b/lib/MetamodelX/Red/Model.pm6 index 93ef8617..a02f1ea6 100644 --- a/lib/MetamodelX/Red/Model.pm6 +++ b/lib/MetamodelX/Red/Model.pm6 @@ -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, From 3cdb36b32e37c4b29fd21cbe96f67236f0b02c71 Mon Sep 17 00:00:00 2001 From: Yiyi Hu Date: Sat, 2 Nov 2019 20:46:58 +0800 Subject: [PATCH 2/6] Additional types text/json/jsonb info for Driver::Pg --- lib/Red/Driver/Pg.pm6 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/Red/Driver/Pg.pm6 b/lib/Red/Driver/Pg.pm6 index ac507d08..95aec209 100644 --- a/lib/Red/Driver/Pg.pm6 +++ b/lib/Red/Driver/Pg.pm6 @@ -111,6 +111,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") {} +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 " \"$=(\w+)\"/) { From 18038bf542257f4a6bd167c3b3ee8246b8256420 Mon Sep 17 00:00:00 2001 From: Yiyi Hu Date: Sat, 2 Nov 2019 21:14:41 +0800 Subject: [PATCH 3/6] Fix In operation for Driver::Pg --- lib/Red/Driver/Pg.pm6 | 16 +++++++++++++++ t/20-in-pg.t | 48 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 64 insertions(+) create mode 100644 t/20-in-pg.t diff --git a/lib/Red/Driver/Pg.pm6 b/lib/Red/Driver/Pg.pm6 index 95aec209..2927e412 100644 --- a/lib/Red/Driver/Pg.pm6 +++ b/lib/Red/Driver/Pg.pm6 @@ -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?) { + if .right.value ~~ Positional { + my ($lstr, @lbind) := do given self.translate: .left, $context { .key, .value } + + if .right.value.elems == 0 { + return "$lstr { .op } (SELECT 0 WHERE false)" => @lbind; + } + + my $in-placeholder = '(' ~ (self.wildcard xx .right.value.elems).join(',') ~ ')'; + + 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) { diff --git a/t/20-in-pg.t b/t/20-in-pg.t new file mode 100644 index 00000000..564cc97c --- /dev/null +++ b/t/20-in-pg.t @@ -0,0 +1,48 @@ +use Red; +use Test; + +my $*RED-PG-TEST-DB = $_ with %*ENV; + +my $*RED-DEBUG = $_ with %*ENV; +my $*RED-DEBUG-AST = $_ with %*ENV; + +plan 2; +unless $*RED-PG-TEST-DB { + "No RED_PG_TEST_DB initialized.".say; + skip-rest 2; +} + +model Category is table { + has Int $.id is serial; + has Int $.parent_id is column{ :references{ Category.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"; + From cd6984aa28ac381792da5545a290f86a9f0922a5 Mon Sep 17 00:00:00 2001 From: Yiyi Hu Date: Thu, 16 Jan 2020 09:50:09 +0000 Subject: [PATCH 4/6] Use self.wildcard to implement the In with @array values. --- lib/Red/Driver/CommonSQL.pm6 | 4 ++-- lib/Red/Driver/Pg.pm6 | 16 ---------------- 2 files changed, 2 insertions(+), 18 deletions(-) diff --git a/lib/Red/Driver/CommonSQL.pm6 b/lib/Red/Driver/CommonSQL.pm6 index 24b5b3cc..6d57468b 100644 --- a/lib/Red/Driver/CommonSQL.pm6 +++ b/lib/Red/Driver/CommonSQL.pm6 @@ -523,7 +523,7 @@ multi method translate(Red::AST::Value $_ where .type ~~ Red::AST::Select, $cont } multi method translate(Red::AST::Value $_ where .type ~~ Positional, $context?) { - '( ' ~ .get-value.map( -> $v { '?' } ).join(', ') ~ ' )' => .get-value; + '( ' ~ .get-value.map( -> $v { self.wildcard } ).join(', ') ~ ' )' => .get-value; } multi method translate(Red::AST::Value $_ where .type.HOW ~~ Metamodel::EnumHOW, $context?) { @@ -738,4 +738,4 @@ multi method prepare-json-path-item(@items) { } multi method prepare-json-path-item(Red::AST::Value $_) { self.prepare-json-path-item: .value } multi method prepare-json-path-item(Int $_) { "[{ $_ }]" } -multi method prepare-json-path-item(Str $_) { ".{ $_ }" } \ No newline at end of file +multi method prepare-json-path-item(Str $_) { ".{ $_ }" } diff --git a/lib/Red/Driver/Pg.pm6 b/lib/Red/Driver/Pg.pm6 index 84d6e2bd..2145069c 100644 --- a/lib/Red/Driver/Pg.pm6 +++ b/lib/Red/Driver/Pg.pm6 @@ -38,22 +38,6 @@ multi method translate(Red::AST::Update $_, $context?, :$gambi where !*.defined) self.Red::Driver::CommonSQL::translate($_, $context, :gambi); } -multi method translate(Red::AST::In $_, $context?) { - if .right.value ~~ Positional { - my ($lstr, @lbind) := do given self.translate: .left, $context { .key, .value } - - if .right.value.elems == 0 { - return "$lstr { .op } (SELECT 0 WHERE false)" => @lbind; - } - - my $in-placeholder = '(' ~ (self.wildcard xx .right.value.elems).join(',') ~ ')'; - - 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) { From 34c20963e7aeed7ac42ae8710ab8e34290a60c4b Mon Sep 17 00:00:00 2001 From: Yiyi Hu Date: Thu, 16 Jan 2020 14:48:14 +0000 Subject: [PATCH 5/6] $data structure fix for Postgres, so it behave consistently with SQLite for SQLite, it re-fetches the row from the model by using LastInsertedRow class, Then the `.row{@ids}` does the right thing all the time. But in postgres, the $data will filled by `INSERT INTO table xxx RETURNING *` after the RETURNING, we'll $data with column names with underscores. So, in the pg case, We convert the $data structure according to the model, make $data look like the same as fetched with LastInsertedRow class. --- lib/MetamodelX/Red/Model.pm6 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lib/MetamodelX/Red/Model.pm6 b/lib/MetamodelX/Red/Model.pm6 index 1be7fe3f..b1b86666 100644 --- a/lib/MetamodelX/Red/Model.pm6 +++ b/lib/MetamodelX/Red/Model.pm6 @@ -451,6 +451,11 @@ multi method create(\model, *%orig-pars, :$with where not .defined) is rw { my $filter = model.^id-filter: |do if $data.defined and not $data.elems { $*RED-DB.execute(Red::AST::LastInsertedRow.new: model).row{|@ids}:kv } else { + for model.^id>>.column -> $column { + if $data{$column.name}:exists { + $data{$column.attr-name} = $data{$column.name}:delete; + } + } $data{|@ids}:kv }.Hash if @ids; From d3b0cab7e6e2878eedf1d4a1cc16282a90a93626 Mon Sep 17 00:00:00 2001 From: Yiyi Hu Date: Thu, 16 Jan 2020 15:23:52 +0000 Subject: [PATCH 6/6] Use data-copy to prevent modify of immutable exception. --- lib/MetamodelX/Red/Model.pm6 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/MetamodelX/Red/Model.pm6 b/lib/MetamodelX/Red/Model.pm6 index b1b86666..6617baa3 100644 --- a/lib/MetamodelX/Red/Model.pm6 +++ b/lib/MetamodelX/Red/Model.pm6 @@ -451,12 +451,12 @@ multi method create(\model, *%orig-pars, :$with where not .defined) is rw { my $filter = model.^id-filter: |do if $data.defined and not $data.elems { $*RED-DB.execute(Red::AST::LastInsertedRow.new: model).row{|@ids}:kv } else { - for model.^id>>.column -> $column { - if $data{$column.name}:exists { - $data{$column.attr-name} = $data{$column.name}:delete; - } - } - $data{|@ids}:kv + my %data-copy = model.^id>>.column.map({ + $data{.name}:exists + ?? (.attr-name => $data{.name}) + !! (.attr-name => $data{.attr-name}) + }); + %data-copy{|@ids}:kv }.Hash if @ids; for %positionals.kv -> $name, @val {