From bef8e68f29561aee7f564f73d478964d626cdaef Mon Sep 17 00:00:00 2001 From: Fernando Correa de Oliveira Date: Tue, 24 Sep 2019 00:16:36 +0100 Subject: [PATCH] WiP: adding a centralized supply of events. Related to #400 --- lib/MetamodelX/Red/Model.pm6 | 20 ++++++++++++++++++-- lib/Red.pm6 | 4 ++++ lib/Red/Class.pm6 | 11 +++++++++++ lib/Red/Database.pm6 | 4 ++++ lib/Red/Do.pm6 | 19 +++++++------------ lib/Red/Driver.pm6 | 18 ++++++++++++++++++ lib/Red/Driver/Cache.pm6 | 15 +++++++++++++-- lib/Red/Event.pm6 | 11 +++++++++++ t/22-red-do.t | 6 +++--- 9 files changed, 89 insertions(+), 19 deletions(-) create mode 100644 lib/Red/Class.pm6 create mode 100644 lib/Red/Event.pm6 diff --git a/lib/MetamodelX/Red/Model.pm6 b/lib/MetamodelX/Red/Model.pm6 index 2fb0840a..b8868ece 100644 --- a/lib/MetamodelX/Red/Model.pm6 +++ b/lib/MetamodelX/Red/Model.pm6 @@ -26,6 +26,7 @@ use MetamodelX::Red::OnDB; use MetamodelX::Red::Id; use X::Red::Exceptions; use Red::Phaser; +use Red::Event; =head2 MetamodelX::Red::Model @@ -46,6 +47,14 @@ has @!constraints; has $.table; has Bool $!temporary; +multi method emit(Mu $model, Red::Event $event) { + get-RED-DB.emit: $event.clone: :model($model.WHAT) +} + +multi method emit(Mu $model, $data) { + get-RED-DB.emit: Red::Event.new: :model($model.WHAT), :$data +} + #| Returns a list of columns names.of the model. method column-names(|) { @!columns>>.column>>.name } @@ -249,8 +258,7 @@ multi method create-table(\model) { die X::Red::InvalidTableName.new: :table(model.^table) unless get-RED-DB.is-valid-table-name: model.^table ; - get-RED-DB.execute: - Red::AST::CreateTable.new: + my $data = Red::AST::CreateTable.new: :name(model.^table), :temp(model.^temp), :columns[|model.^columns.map(*.column)], @@ -266,6 +274,14 @@ multi method create-table(\model) { ], |(:comment(Red::AST::TableComment.new: :msg(.Str), :table(model.^table)) with model.WHY) ; + get-RED-DB.execute: |$data; + self.emit: model, Red::Event.new: :$data; + CATCH { + default { + self.emit: model, Red::Event.new: :$data, :error($_); + proceed + } + } True } diff --git a/lib/Red.pm6 b/lib/Red.pm6 index d102387b..2571accc 100644 --- a/lib/Red.pm6 +++ b/lib/Red.pm6 @@ -16,6 +16,7 @@ use Red::AST::Infixes; use Red::AST::Optimizer::AND; use Red::AST::Optimizer::OR; use Red::AST::Optimizer::Case; +use Red::Class; class Red:ver<0.0.4>:api<1> {} @@ -43,6 +44,7 @@ multi EXPORT("red-do") { Red::Traits::EXPORT::ALL::, Red::Operators::EXPORT::ALL::, ‘&database’ => &database, + 'red' => Red::Class.instance, ) } @@ -55,6 +57,7 @@ multi EXPORT("experimental migrations") { Red::Traits::EXPORT::ALL::, Red::Operators::EXPORT::ALL::, ‘&database’ => &database, + 'red' => Red::Class.instance, ) } @@ -63,6 +66,7 @@ multi EXPORT { Red::Traits::EXPORT::ALL::, Red::Operators::EXPORT::ALL::, ‘&database’ => &database, + 'red' => Red::Class.instance, ) } diff --git a/lib/Red/Class.pm6 b/lib/Red/Class.pm6 new file mode 100644 index 00000000..8b309981 --- /dev/null +++ b/lib/Red/Class.pm6 @@ -0,0 +1,11 @@ +unit class Red::Class; + +method instance(::?CLASS:U: --> ::?CLASS:D) { $ //= self.bless } +method new {!!!} + +has Supplier $!supplier .= new; +has Supply $.events = $!supplier.Supply; + +method register-supply(Supply $_) { + .tap: { $!supplier.emit: $_ } +} \ No newline at end of file diff --git a/lib/Red/Database.pm6 b/lib/Red/Database.pm6 index 971355f7..9d3b0ff5 100644 --- a/lib/Red/Database.pm6 +++ b/lib/Red/Database.pm6 @@ -15,6 +15,8 @@ multi sub database(Str $type, |c --> Red::Driver) is export { my $driver-name = "Red::Driver::$type"; require ::($driver-name); my Red::Driver $driver = ::($driver-name).new: |c; + $driver.auto-register; + $driver } #| Accepts an SQL driver name and a database handle, and @@ -23,4 +25,6 @@ multi sub database(Str $type, $dbh --> Red::Driver) { my $driver-name = "Red::Driver::$type"; require ::($driver-name); my Red::Driver $driver = ::($driver-name).new: :$dbh; + $driver.auto-register; + $driver } diff --git a/lib/Red/Do.pm6 b/lib/Red/Do.pm6 index 9d80189f..c9a16dc4 100644 --- a/lib/Red/Do.pm6 +++ b/lib/Red/Do.pm6 @@ -1,6 +1,9 @@ use Red::Database; use Red::Driver; use X::Red::Exceptions; +use Red::Class; +use Red::Event; +use Red::DB; =head1 This module is experimental, to use it, do: @@ -71,22 +74,14 @@ multi red-defaults(*%drivers) is export { }).Hash; } -sub supply-pair-for-name(Str $name) { - %*RED-SUPPLIES{$name} //= do { - my Supplier $supplier .= new; - my $supply = $supplier.Supply; - { :$supplier, :$supply } - } -} - -sub red-emit(Str() $name, |c) is export { - supply-pair-for-name($name).emit: |c +sub red-emit(Str() $name, $data) is export { + get-RED-DB.emit: Red::Event.new: :$name, :$data } sub red-tap(Str() $name, &func, :$red-db = $*RED-DB) is export { - supply-pair-for-name($name).tap: -> |c { + Red::Class.instance.events.grep({ .name eq $name }).tap: -> Red::Event $_ { my $*RED-DB = $red-db; - func |c + func .data } } diff --git a/lib/Red/Driver.pm6 b/lib/Red/Driver.pm6 index b399f6a4..31af50ef 100644 --- a/lib/Red/Driver.pm6 +++ b/lib/Red/Driver.pm6 @@ -2,11 +2,29 @@ use Red::AST; use Red::Column; use Red::SchemaReader; use X::Red::Exceptions; +use Red::Class; +use Red::Event; =head2 Red::Driver unit role Red::Driver; +has Supplier $!supplier .= new; +has Supply $.events = $!supplier.Supply; + +method auto-register(|) { + Red::Class.instance.register-supply: $!events; + self +} + +multi method emit($data) { + $!supplier.emit: Red::Event.new: :db(self), :db-name(self.^name), :$data +} + +multi method emit(Red::Event $event) { + $!supplier.emit: $event.clone: :db(self), :db-name(self.^name) +} + method schema-reader(--> Red::SchemaReader) { ... } method translate(Red::AST, $?) { ... } multi method prepare(Str) { ... } diff --git a/lib/Red/Driver/Cache.pm6 b/lib/Red/Driver/Cache.pm6 index f307c0bf..5f573e55 100644 --- a/lib/Red/Driver/Cache.pm6 +++ b/lib/Red/Driver/Cache.pm6 @@ -26,13 +26,24 @@ multi cache(Str $cache, Pair $driver-pair) { cache $cache => \(), $driver-pair } +multi cache(Str $cache, Red::Driver $driver) { + cache $cache => \(), $driver +} + +multi cache(Pair (Str :key($cache-driver), Capture :value($cache-conf)), Red::Driver $driver) { + my $cache = "Red::Driver::Cache::$cache-driver"; + require ::($cache); + ::($cache).new: :$driver, |$cache-conf +} + multi cache( Pair (Str :key($cache-driver), Capture :value($cache-conf)), - Pair (Str :key($driver), Capture :value($driver-conf)) + Pair (Str :key($driver-name), Capture :value($driver-conf)) ) is export { + my $driver = database $driver-name, |$driver-conf; my $cache = "Red::Driver::Cache::$cache-driver"; require ::($cache); - ::($cache).new: :driver(database $driver, |$driver-conf), |$cache-conf + ::($cache).new: :$driver, |$cache-conf } multi method get-from-cache(Red::AST) { ... } diff --git a/lib/Red/Event.pm6 b/lib/Red/Event.pm6 new file mode 100644 index 00000000..545bbbf6 --- /dev/null +++ b/lib/Red/Event.pm6 @@ -0,0 +1,11 @@ +use Red::Model; +unit class Red::Event; + +has $.db; +has Str $.db-name; +has Str $.driver-name; +has Str $.name; +has $.data; +has Red::Model:U $.model; +has Red::Model $.origin; +has Exception $.error; \ No newline at end of file diff --git a/t/22-red-do.t b/t/22-red-do.t index 2d27b7c4..86c943a7 100644 --- a/t/22-red-do.t +++ b/t/22-red-do.t @@ -106,9 +106,9 @@ use Red::Driver::Cache; use Red::Driver::Cache::Memory; red-defaults - bla => \(database("SQLite", :database<./a.db>)), - ble => \(database("SQLite", :database<./b.db>)), - cache => \(cache "Memory", "SQLite"), + bla => database("SQLite", :database<./a.db>), + ble => database("SQLite", :database<./b.db>), + cache => cache("Memory", "SQLite"), ; red-do