Red.git | lib/MetamodelX/Red/ | Model.rakumod
use v6;
use Red::Model;
use Red::Attr::Column;
use Red::Column;
use Red::Utils;
use Red::ResultSeq;
use Red::DefaultResultSeq;
use Red::Attr::Query;
use Red::DB;
use Red::AST;
use Red::AST::Value;
use Red::AST::Insert;
use Red::AST::Delete;
use Red::AST::Update;
use Red::AST::Infixes;
use Red::AST::CreateTable;
use Red::AST::Constraints;
use Red::AST::TableComment;
use Red::AST::LastInsertedRow;
use Red::AST::CreateView;
use MetamodelX::Red::Dirtable;
use MetamodelX::Red::Comparate;
use MetamodelX::Red::Migration;
use MetamodelX::Red::Relationship;
use MetamodelX::Red::Describable;
use MetamodelX::Red::OnDB;
use MetamodelX::Red::Id;
use MetamodelX::Red::Populatable;
use MetamodelX::Red::Specialisable;
use MetamodelX::Red::View;
use MetamodelX::Red::VirtualView;
use MetamodelX::Red::PreFetch;
use Red::Formatter;
use X::Red::Exceptions;
use Red::Phaser;
use Red::Event;
use Red::PrepareCode;
=head2 MetamodelX::Red::Model
unit class MetamodelX::Red::Model is Metamodel::ClassHOW;
also does MetamodelX::Red::Dirtable;
also does MetamodelX::Red::Comparate;
#also does MetamodelX::Red::Migration;
also does MetamodelX::Red::Relationship;
also does MetamodelX::Red::Describable;
also does MetamodelX::Red::OnDB;
also does MetamodelX::Red::Id;
also does MetamodelX::Red::Populatable;
also does MetamodelX::Red::Specialisable;
also does MetamodelX::Red::PreFetch;
also does Red::Formatter;
has Attribute @!columns;
has Red::Column %!references;
has %!attr-to-column;
has $.rs-class;
has @!constraints;
has $.table;
has $.database;
has Bool $!temporary;
has Bool $!default-null;
has %!alias-cache;
has $!alias-cache-lock = Lock.new;
multi method emit(Mu $model, Red::Event $event) {
start try get-RED-DB.emit: $event.clone: :model($model.WHAT)
}
multi method emit(Mu $model, $data, Exception :$error, Red::Model :$origin) {
self.emit: $model, Red::Event.new: :model($model.WHAT), |(:$data with $data), |(:$error with $error)
}
#| Returns a list of columns names.of the model.
method column-names(|) { @!columns>>.column>>.name }
#| Returns a hash of model constraints classified by type.
method constraints(|) { @!constraints.unique.classify: *.key, :as{ .value } }
#| Returns a hash of foreign keys of the model.
method references(|) { %!references }
#| Returns the table name for the model.
method table(Mu \type) is rw {
$!table //= self.table-formatter: type.HOW.?experimental-name(type) // type.^name
}
#| Returns the table alias
method as(Mu \type) { self.table: type }
#| Returns the original model
method orig(Mu \type) { type.WHAT }
#| Returns the name of the ResultSeq class
method rs-class-name(Mu \type) { "{type.^name}::ResultSeq" }
#| Returns a list of columns
method columns(|) is rw {
@!columns
}
method column-values(\model --> Hash()) {
self.columns(model).map: { .column.attr-name => .get_value: model }
}
#| Returns a hash with the migration hash
method migration-hash(\model --> Hash()) {
columns => @!columns>>.column>>.migration-hash,
name => model.^table,
version => model.^ver // v0,
}
#| Returns a liast of id values
method id-values(Red::Model:D $model) {
self.id($model).map({ .get_value: $model }).list
}
#| Check if the model is nullable by default.
method default-nullable(|) is rw { $!default-null }
#| Returns all columns with the unique counstraint
method unique-constraints(\model) {
@!constraints.unique.grep(*.key eq "unique").unique.map: *.value.map: *.attr
}
#| A map from attr to column
method attr-to-column(|) is rw {
%!attr-to-column
}
method set-helper-attrs(Mu \type) {
self.MetamodelX::Red::Dirtable::set-helper-attrs(type);
self.MetamodelX::Red::OnDB::set-helper-attrs(type);
self.MetamodelX::Red::Id::set-helper-attrs(type);
}
method new(|c) {
my @eroles = @Red::experimental-roles.grep(self !~~ *).sort({ $^a.^name cmp $^b.^name});
if +@eroles {
return (self.^mixin: |@eroles).new(|c)
}
nextsame
}
multi method submodel(\model, &refinement) {
self.submodel: model, model.^name, &refinement
}
multi method submodel(\model, Str $name, &refinement) {
use MetamodelX::Red::SubModelHOW;
(
Metamodel::SubsetHOW but MetamodelX::Red::SubModelHOW
).new_type: :$name, :refinee(model), :&refinement;
}
method SubsetHOW(|) {
MetamodelX::Red::SubsetHOW
}
#| Compose
method compose(Mu \type) {
self.set-helper-attrs: type;
type.^prepare-relationships;
if $.rs-class === Any {
my $rs-class-name = $.rs-class-name(type);
# TODO
#my $rs-class = ::($rs-class-name);
#if !$rs-class && $rs-class !~~ Failure {
# $!rs-class = $rs-class;
#} else {
$!rs-class := create-resultseq($rs-class-name, type);
type.WHO<ResultSeq> := $!rs-class
#}
}
die "{$.rs-class.^name} should do the Red::ResultSeq role" unless $.rs-class ~~ Red::ResultSeq;
self.add_role: type, Red::Model unless type ~~ Red::Model;
self.add_role: type, role :: {
method TWEAK(|c) {
self.^set-dirty: self.^columns;
self.?TWEAK-MODEL(|c)
}
}
my @roles-cols = self.roles_to_compose(type).grep({ .HOW !~~ Metamodel::CurriedRoleHOW }).flatmap(*.^attributes).grep: Red::Attr::Column;
for @roles-cols -> Red::Attr::Column $attr {
self.add-comparate-methods: type, $attr
}
type.^compose-columns;
self.Metamodel::ClassHOW::compose(type);
type.^compose-columns;
for type.^attributes -> $attr {
%!attr-to-column{$attr.name} = $attr.column.name if $attr ~~ Red::Attr::Column:D;
}
self.compose-dirtable: type;
for type.^columns.grep(*.column.unique-groups.elems > 0).categorize(*.column.unique-groups).values -> @grp {
type.^add-unique-constraint: -> | { @grp>>.column }
}
if type.^constraints<pk>:!exists {
type.^add-pk-constraint: type.^id>>.column if type.^id > 1
}
}
#| Creates a new reference (foreign key).
method add-reference($name, Red::Column $col) {
%!references{$name} = $col
}
#| Creates a new unique constraint.
method add-unique-constraint(Mu:U \type, &columns) {
my $*RED-INTERNAL = True;
@!constraints.push: "unique" => columns(type)
}
#| Creates a new primary key constraint.
multi method add-pk-constraint(Mu:U \type, &columns) {
my $*RED-INTERNAL = True;
nextwith type, columns(type)
}
#| Creates the primary key constraint.
multi method add-pk-constraint(Mu:U \type, @columns) {
@!constraints.push: "pk" => @columns
}
method tables(\model) { [ model ] }
proto method join($, $, $, :$name, :$opposite, *%pars where { .elems == 0 || ( .elems == 1 && get-RED-DB.join-type(.keys.head) && so .values.head ) }) {*}
multi method join(\model, \to-join, &on, :$name, *%pars) {
to-join.^alias: |($_ with $name), :base(model), :relationship(&on.assuming: model), :join-type(%pars.keys.head // "")
}
multi method join(\model, \to-join, Red::AST $on, :$name, *%pars) {
to-join.^alias: |($_ with $name), :base(model), :relationship($on), :join-type(%pars.keys.head // "")
}
multi method join(\model, \to-join, $on where *.^can("relationship-ast"), :$name, :$opposite! where *.so) {
to-join.^alias: :opposite, |($_ with $name), :base(model), :relationship($on), :join-type($on.join-type.keys.head // "")
}
multi method join(\model, \to-join, $on where *.^can("relationship-ast"), :$name, :$opposite? where { .not }) {
to-join.^alias: |($_ with $name), :base(model), :relationship($on), :join-type($on.join-type.keys.head // "")
}
my UInt $alias_num = 1;
method alias(|c (Red::Model:U \type, Str $name = "{type.^name}_{$alias_num++}", :$base, :$relationship, :$join-type, Bool :$opposite)) {
my $cache-key = c.WHICH;
$!alias-cache-lock.protect: {
return %!alias-cache{$cache-key} if %!alias-cache{$cache-key}:exists;
my \alias = ::?CLASS.new_type(:$name);
my role RAlias[Red::Model:U \rtype, Str $rname, \alias, \rel, \base, \join-type, @cols] {
method columns(|) { @cols }
method table(|) { rtype.^table }
method as(|) { self.table-formatter: $rname }
method orig(|) { rtype }
method join-type(|) { join-type }
method tables(|) { [ |base.^tables, alias ] }
method join-on(|) {
my $*RED-INTERNAL = True;
do given rel {
when Red::AST {
$_
}
when Callable {
my $filter = do given what-does-it-do($_, alias) {
do if [eqv] .values {
.values.head
} else {
.kv.map(-> $test, $ret {
do with $test {
Red::AST::AND.new: $test, ast-value $ret
} else {
$ret
}
}).reduce: -> $agg, $fil? { $fil.DEFINITE ?? Red::AST::OR.new: $agg, $fil !! $agg }
}
}
with $*RED-GREP-FILTER {
$filter = Red::AST::AND.new: ($_ ~~ Red::AST ?? $_ !! .&ast-value), $filter
}
$filter
}
default {
.relationship-ast(alias, |(base if $opposite))
}
}
}
}
# alias.^add_role: Red::Model;
my @cols = do for @!columns -> $col {
my $new-col = Attribute.new:
:name($col.name),
:package(alias),
:type($col.type),
:has_acessor($col.has_accessor),
:build($col.build)
;
$new-col does Red::Attr::Column($col.column.Hash);
alias.^add-comparate-methods: $new-col;
$new-col
}
alias.HOW does RAlias[type, $name, alias, $relationship, $base, $join-type, @cols];
for self.relationships.keys -> $rel {
alias.^add-relationship: $rel.transfer: alias
}
alias.^compose;
%!alias-cache{$cache-key} = alias;
return alias;
}
}
#| Creates a new column and adds it to the model.
method add-column(::T Red::Model:U \type, Red::Attr::Column $attr) {
if $attr.name eq @!columns.none.name {
@!columns.push: $attr;
my $name = $attr.name.substr: 2;
with $attr.args{"references" | "model-name"} {
self.add-reference: $name, $attr.column
}
self.add-comparate-methods(T, $attr);
if $attr.has_accessor && !T.^can($name) {
if type.^rw or $attr.rw {
$attr does role :: { method rw { True } };
T.^add_multi_method: $name, my method (Red::Model:D:) is rw {
use nqp;
nqp::getattr(self, self.WHAT, $attr.name)
}
} else {
T.^add_multi_method: $name, my method (Red::Model:D:) {
$attr.get_value: self
}
}
}
}
}
method compose-columns(Red::Model:U \type) {
for self.attributes(type).grep: Red::Attr::Column -> Red::Attr::Column $attr {
# $attr.clone;
# $attr.create-column;
type.^add-column: $attr.clone: :package(type)
}
}
#| Returns the ResultSeq
multi method rs(Mu:U --> Red::ResultSeq) { $.rs-class.new }
multi method rs(Mu:U, :$with! --> Red::ResultSeq) { $.rs-class.new.with: $with }
multi method rs(Mu:D $obj --> Red::ResultSeq) { $.rs-class.new: :$obj }
multi method rs(Mu:D $obj, :$with! --> Red::ResultSeq) { $.rs-class.new(:$obj).with($with) }
#| Alias for C<.rs()>
multi method all($obj --> Red::ResultSeq) { $obj.^rs }
multi method all($obj, :$with! --> Red::ResultSeq) { $obj.^rs(:$with) }
#| Sets model as a temporary table
method temp(|) is rw { $!temporary }
multi method create-table(Str :$with!, |c) {
my $*RED-DB = %GLOBAL::RED-DEFAULT-DRIVERS{$with};
self.create-table: |c
}
multi method create-table(Red::Driver :$with!, |c) {
my $*RED-DB = $with;
self.create-table: |c
}
#| Creates table unless table already exists
multi method create-table(\model where { .HOW !~~ MetamodelX::Red::View | MetamodelX::Red::VirtualView }, Bool :unless-exists(:$if-not-exists) where so *, *%pars) {
CATCH {
when X::Red::Driver::Mapped::TableExists {
return False
}
}
self.create-table: model, |%pars
}
multi method create-table(\model where { .HOW ~~ MetamodelX::Red::VirtualView }, |) {}
multi method create-table(\model where { .HOW ~~ MetamodelX::Red::View }, |) {
die X::Red::InvalidTableName.new: :table(model.^table)
unless get-RED-DB.is-valid-table-name: model.^table
;
my $data = Red::AST::CreateView.new:
:name(model.^table),
:temp(model.^temp),
:select(model.?sql),
:ast(model.?ast),
|(:comment(Red::AST::TableComment.new: :msg(.Str), :table(model.^table)) with model.WHY)
;
get-RED-DB.execute: |$data;
self.emit: model, $data;
CATCH {
default {
self.emit: model, $data, :error($_);
proceed
}
}
True
}
#| Creates table
multi method create-table(\model where { .HOW !~~ MetamodelX::Red::View | MetamodelX::Red::VirtualView }, :$with where not .defined, :if-not-exists($unless-exists) where not .defined) {
die X::Red::InvalidTableName.new: :table(model.^table)
unless get-RED-DB.is-valid-table-name: model.^table
;
my $data = Red::AST::CreateTable.new:
:name(model.^table),
:temp(model.^temp),
:columns(model.^columns.map(*.column.clone: :class(model))),
:constraints[
|@!constraints.unique.map: {
when .key ~~ "unique" {
Red::AST::Unique.new: :columns[|.value]
}
when .key ~~ "pk" {
Red::AST::Pk.new: :columns[|.value]
}
}
],
|(:comment(Red::AST::TableComment.new: :msg(.Str), :table(model.^table)) with model.WHY)
;
get-RED-DB.execute: |$data;
self.emit: model, $data;
CATCH {
default {
self.emit: model, $data, :error($_);
proceed
}
}
True
}
#| Applies phasers
method apply-row-phasers($obj, Mu:U $phase ) {
my $*RED-INTERNAL = True;
for (|$obj.^methods.grep($phase), |$obj.^private_method_table.values.grep($phase)) -> $meth {
$obj.$meth(|($meth.count > 1 ?? $obj !! Empty));
}
}
multi method save(Red::Driver :$with!, |c) {
my $*RED-DB = $with;
self.save: |c
}
multi method save(Str :$with!, |c) {
my $*RED-DB = %GLOBAL::RED-DEFAULT-DRIVERS{$with};
self.save: |c
}
#| Saves that object on database (create a new row)
multi method save($obj, Bool :$insert! where * == True, Bool :$from-create, :$with where not .defined) {
self.apply-row-phasers($obj, BeforeCreate) unless $from-create;
my $ast = Red::AST::Insert.new: $obj;
my $ret := get-RED-DB.execute: $ast;
$obj.^saved-on-db;
$obj.^populate-ids;
self.apply-row-phasers($obj, AfterCreate) unless $from-create;
self.emit: $obj, $ast;
CATCH {
default {
self.emit: $obj, $ast, :error($_);
proceed
}
}
$obj.^clean-up;
$ret
}
#| Saves that object on database (update the row)
multi method save($obj, Bool :$update! where * == True, :$with where not .defined) {
self.apply-row-phasers($obj, BeforeUpdate);
my $ast = Red::AST::Update.new: $obj;
my $ret := get-RED-DB.execute: $ast;
$obj.^saved-on-db;
$obj.^populate-ids;
self.apply-row-phasers($obj, AfterUpdate);
self.emit: $obj, $ast;
CATCH {
default {
self.emit: $obj, $ast, :error($_);
proceed
}
}
$obj.^clean-up;
$ret
}
#| Generic save, calls C<.^save: :insert> if C<.^is-on-db> or C<.^save: :update> otherwise
multi method save($obj, :$with where not .defined) {
do if $obj.^is-on-db {
self.save: $obj, :update
} else {
self.save: $obj, :insert
}
}
multi method create($, Red::Driver :$with!, |c) is hidden-from-backtrace {
my $*RED-DB = $with;
self.create: |c
}
multi method create($, Str :$with!, |c) is hidden-from-backtrace {
self.create: :with(%GLOBAL::RED-DEFAULT-DRIVERS{$with}), |c
}
#| Creates a new object and saves it on DB
#| It accepts a list os pairs (the same as C<.new>)
#| And Lists and/or Hashes for relationships
multi method create(\model where *.DEFINITE, *%orig-pars, :$with where not .defined) is hidden-from-backtrace is rw {
die "Cannot call .^create on a defined model." if model.DEFINITE;
my $RED-DB = get-RED-DB;
my $trans = so $*RED-TRANSACTION-RUNNING;
$RED-DB .= begin unless $trans;
KEEP $RED-DB.commit unless $trans;
UNDO try $RED-DB.rollback unless $trans;
{
my $*RED-DB = $RED-DB;
my $*RED-TRANSACTION-RUNNING = True;
my %relationships = %.relationships.keys.map: {
.name.substr(2) => $_
}
my %pars;
my %positionals;
my %has-one{Mu};
for %orig-pars.kv -> $name, $val {
my \attr = model.^attributes.first(*.name.substr(2) eq $name);
my \attr-type = attr.type;
with %relationships{ $name } {
my \attr-model = attr.relationship-model;
if $val ~~ Seq {
%positionals{$name} = $val.Array
} elsif $val ~~ Positional && attr-type ~~ Positional {
%positionals{$name} = $val
} elsif .has-one {
die "Value of '$name' should be Associative" unless $val ~~ Associative;
# my $type = attr.relationship-model;
# try { attr-type.^find(|$val) } // attr-type.^create: |$val
%has-one{$val} = attr
} elsif $val ~~ Associative && $val !~~ Red::Model {
%pars{$name} = do if attr-model ~~ Red::Model {
try { attr-model.^find(|$val) } // attr-model.^create: |$val
} else {
try { attr-type.^find(|$val) } // attr-type.^create: |$val
}
} else {
%pars{$name} = $val
}
} else {
%pars{$name} = $val
}
}
my $obj = model.new: |%pars;
self.apply-row-phasers($obj, BeforeCreate);
my $data := $obj.^save(:insert, :from-create).row;
my @ids = model.^id>>.column>>.attr-name;
my @ids-col = model.^id>>.column>>.name;
my %cols = model.^columns.map: { .column.attr-name => .column };
my $filter = do if @ids {
model.^id-filter: |do if $data.defined and not $data.elems {
$*RED-DB.execute(Red::AST::LastInsertedRow.new: model).row{|@ids}:kv
} else {
do for @ids-col.kv -> $i, $k {
@ids[$i] => $data{$k}
}
}.Hash
} else {
%pars.kv.map(-> $key, $value {
next without $value;
next without %cols{$key};
Red::AST::Eq.new: %cols{$key}, ast-value $value
})
.reduce: -> $a, $b? { $b.DEFINITE ?? Red::AST::AND.new: $a, $b !! $a }
} unless $data<>;
my $no;
if %positionals || %has-one {
$no = do {
my $obj;
if !$data.elems {
$obj = model.^find: $filter
} else {
$obj = model.^new-from-data($data.elems ?? |$data !! |%orig-pars);
$obj.^saved-on-db;
$obj.^clean-up;
$obj.^populate-ids;
}
$obj
}
for %positionals.kv -> $name, @val {
my \rs = $no."$name"();
rs.create: |$_ for @val;
}
for %has-one.kv -> %val, \attr {
my $type = attr.relationship-model;
my $id-name = attr.rel.attr-name;
#TODO: What to do when there is more than one id???
$type.^create: |%( |%val, $id-name => $no.^id-values.head )
}
}
self.apply-row-phasers($obj, AfterCreate);
.return with $no;
return-rw Proxy.new:
STORE => -> | {
die X::Assignment::RO.new(value => $obj)
},
FETCH => {
$ //= do {
my $obj;
my $*RED-DB = $RED-DB;
if !$data.elems {
$obj = model.^find: $filter
} else {
$obj = model.^new-from-data($data.elems ?? |$data !! |%orig-pars);
$obj.^saved-on-db;
$obj.^clean-up;
$obj.^populate-ids;
}
$obj
}
}
}
}
multi method delete(Red::Driver :$with!, |c) {
my $*RED-DB = $with;
self.delete: |c
}
multi method delete(Str :$with!, |c) {
my $*RED-DB = %GLOBAL::RED-DEFAULT-DRIVERS{$with};
self.delete: |c
}
#| Deletes row from database
multi method delete(\model, :$with where not .defined) {
my $origin = model.clone;
self.apply-row-phasers(model, BeforeDelete);
my $ast = Red::AST::Delete.new: model;
get-RED-DB.execute: $ast;
self.emit: model, $ast, :$origin;
CATCH {
default {
self.emit: model, $ast, :$origin, :error($_);
proceed
}
}
self.apply-row-phasers(model, AfterDelete);
}
multi method load(Red::Driver :$with!, |c) {
my $*RED-DB = $with;
self.load: |c
}
multi method load(Str :$with!, |c) {
my $*RED-DB = %GLOBAL::RED-DEFAULT-DRIVERS{$with};
self.load: |c
}
#| Loads object from the DB
multi method load(Red::Model:U \model, |ids) {
my $filter = model.^id-filter: |ids;
model.^rs.grep({ $filter }).head
}
#| Creates a new object setting ids with this values
multi method new-with-id(Red::Model:U \model, %ids, :$with where not .defined) {
model.new: |model.^id-map: |%ids;
}
multi method new-with-id(Red::Driver :$with!, |c) {
my $*RED-DB = $with;
self.new-with-id: |c
}
multi method new-with-id(Str :$with!, |c) {
my $*RED-DB = %GLOBAL::RED-DEFAULT-DRIVERS{$with};
self.new-with-id: |c
}
#| Creates a new object setting the id
multi method new-with-id(Red::Model:U \model, |ids) {
model.new: |model.^id-map: |ids;
}
multi method search(Red::Driver :$with!, |c) {
my $*RED-DB = $with;
self.search: |c
}
multi method search(Str :$with!, |c) {
my $*RED-DB = %GLOBAL::RED-DEFAULT-DRIVERS{$with};
self.search: |c
}
sub __RED_OPERATOR_LOADED__ { True }
#| Receives a `Block` of code and returns a `ResultSeq` using the `Block`'s return as filter
multi method search(Red::Model:U \model, &filter, :$with where not .defined) {
model.^rs.grep: &filter
}
#| Receives a `AST` of code and returns a `ResultSeq` using that `AST` as filter
multi method search(Red::Model:U \model, Red::AST $filter, :$with where not .defined) {
samewith model, { $filter }
}
#| Receives a hash of `AST`s of code and returns a `ResultSeq` using that `AST`s as filter
#| Usually passed unique values as IDs or columns with unique counstraint
multi method search(Red::Model:U \model, *%filter, :$with where not .defined) {
my $*RED-INTERNAL = True;
samewith
model,
%filter.kv
.map(-> $k, $value { Red::AST::Eq.new: model."$k"(), Red::AST::Value.new: :$value })
.reduce: -> $a, $b? { $b.DEFINITE ?? Red::AST::AND.new: $a, $b !! $a }
}
multi method find(Red::Driver :$with!, |c) {
my $*RED-DB = $with;
self.find: |c
}
multi method find(Str :$with!, |c) {
my $*RED-DB = %GLOBAL::RED-DEFAULT-DRIVERS{$with};
self.find: |c
}
#| Finds a specific row
#| using the same data as search()
multi method find(|c) { self.search(|c).head }
multi method find(Red::Model:U, Any:U) { die "Could not use find without data" }
multi method get-attr(\instance, Str $name) {
$!col-data-attr.get_value(instance).{ $name }
}
multi method set-attr(\instance, Str $name, \value) {
$!col-data-attr.get_value(instance).{ $name } = value
}
multi method get-attr(\instance, Red::Attr::Column $attr) {
samewith instance, $attr.name.substr: 2
}
multi method set-attr(\instance, Red::Attr::Column $attr, \value) {
samewith instance, $attr.name.substr(2), value
}
method new-from-data(\of, $data) is hidden-from-backtrace {
my %cols-by-attr = of.^columns.map: { .column.attr-name => .column }
my %cols-by-col = of.^columns.map: { .column.name => .column }
my %pre-fetches;
my $obj = of.^orig.new: |(%($data).kv
.map(-> $c, $v {
do with $v {
my $pre-fetch = of.^relationships.keys.first: *.rel-name eq $c;
if $pre-fetch {
%pre-fetches{ $c } = do if $v ~~ Str {
use JSON::Fast;
from-json $v
} else {
$v
}
Empty
} elsif !$c.contains: "." {
my $col = ( %cols-by-col{$c} // %cols-by-attr{$c} );
die "Column '$c' not found" without $col;
die "Inflator not defined for column '$c'" without $col.inflate;
my $inflated = $col.inflate.($v, |($col.attr.type if $col.inflate.count > 1));
$inflated = get-RED-DB.inflate(
$inflated,
:to(of.^attributes.first(*.name.substr(2) eq $c).type)
) if \(
get-RED-DB,
$inflated,
:to(of.^attributes.first(*.name.substr(2) eq $c).type)
) ~~ get-RED-DB.^lookup("inflate").candidates.any.signature;
$col.attr-name => $inflated
}
} else { Empty }
}).Hash
);
my %pre = (%(), |$data.keys).reduce: -> %ag, $key? {
if $key && ($data{ $key }:exists) && $data{ $key }.defined {
my ($first, *@rest) := $key.split(".");
%ag{ $first }{ @rest.join(".") } = $data{ $key } if @rest;
}
%ag
}
if %pre {
for |$obj.^has-one-relationships -> $rel {
with %pre{ $rel.rel-name } {
with $rel.relationship-model.^new-from-data: $_ {
.^saved-on-db;
$rel.set_value: $obj, $_
}
}
}
}
# say "cache prefetches: ", %pre-fetches;
for %pre-fetches.kv -> $key, @value {
my $attr = $obj.^relationships.keys.first(*.rel-name eq $key);
$attr.set_value: $obj, @value.map({ $attr.relationship-model.^new-from-data: $_ }).list
}
$obj
}