Merge branch 'master' of github.com:FCO/Red into create-to-one

FCO · Nov 6, 2021 · 832643a · 832643a
2 parents 3ed6576 + df848ff
commit 832643a
Show file tree

Hide file tree

Showing 37 changed files with 394 additions and 179 deletions.
diff --git a/.coverage b/.coverage
@@ -1 +1 @@
-57
+58
diff --git a/Changes b/Changes
@@ -1,6 +1,9 @@
 Revision history for Red
 
 {{$NEXT}}
+    - Separate the Model generation for changing attributes
+    - Make join on update use subselect
+    - Teaching AST new dance moves (.replace)
 
 0.1.52  2021-10-22T21:33:53+01:00
     - Fix usage of parameterized roles

diff --git a/META6.json b/META6.json
@@ -27,6 +27,7 @@
     "MetamodelX::Red::Populatable": "lib/MetamodelX/Red/Populatable.pm6",
     "MetamodelX::Red::Refreshable": "lib/MetamodelX/Red/Refreshable.pm6",
     "MetamodelX::Red::Relationship": "lib/MetamodelX/Red/Relationship.pm6",
+    "MetamodelX::Red::Specialisable": "lib/MetamodelX/Red/Specialisable.pm6",
     "MetamodelX::Red::Supply": "lib/MetamodelX/Red/Supply.pm6",
     "Red": "lib/Red.pm6",
     "Red::AST": "lib/Red/AST.pm6",

diff --git a/docs/api/Red/AST.md b/docs/api/Red/AST.md
@@ -21,6 +21,26 @@ method Bool() returns Bool
 
 If inside of a block for ResultSeq mothods throws a control exception and populates all possibilities
 
+### method transpose-first
+
+```raku
+method transpose-first(
+    &func
+) returns Mu
+```
+
+Find the first AST node folowing the rule
+
+### method transpose-grep
+
+```raku
+method transpose-grep(
+    &func
+) returns Mu
+```
+
+Find AST nodes folowing the rule
+
 ### method transpose
 
 ```raku

diff --git a/docs/api/Red/Driver/Pg.md b/docs/api/Red/Driver/Pg.md
@@ -1,4 +1,4 @@
-class submethod BUILD (Red::Driver::Pg: DB::Pg :$!dbh, Str :$!user, Str :$!password, Str :$!host = "127.0.0.1", Int :$!port = 5432, Str :$!dbname, *%_) { #`(Submethod|139752632623312) ... }
+class submethod BUILD (Red::Driver::Pg: DB::Pg :$!dbh, Str :$!user, Str :$!password, Str :$!host = "127.0.0.1", Int :$!port = 5432, Str :$!dbname, *%_) { #`(Submethod|139986655638544) ... }
 ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
 
 Data accepted by the Pg driver constructor: dbh : DB::Pg object user : User to be used to connect to the database password: Password to be used to connect to the database host : To be connected to port : What port to connect dbname : Database name

diff --git a/docs/api/Red/Driver/SQLite.md b/docs/api/Red/Driver/SQLite.md
@@ -1,4 +1,4 @@
-class submethod BUILD (Red::Driver::SQLite: DBDish::SQLite::Connection :$!dbh, Str :$!database = ":memory:", *%_) { #`(Submethod|140401313076160) ... }
+class submethod BUILD (Red::Driver::SQLite: DBDish::SQLite::Connection :$!dbh, Str :$!database = ":memory:", *%_) { #`(Submethod|140316593993440) ... }
 -------------------------------------------------------------------------------------------------------------------------------------------------------
 
 Data accepted by the SQLite driver constructor: dbh : DBDish::SQLite object database: File name or C<:memory:> to a in memory DB (default)

diff --git a/docs/coverage/report-data/MetamodelX-Red-Model.html b/docs/coverage/report-data/MetamodelX-Red-Model.html
@@ -75,6 +75,7 @@ <h1>MetamodelX::Red::Model 78.8%</h1>
 <span class="coverage-no">use MetamodelX::Red::OnDB;</span>
 <span class="coverage-no">use MetamodelX::Red::Id;</span>
 <span class="coverage-no">use MetamodelX::Red::Populatable;</span>
+<span class="coverage-no">use MetamodelX::Red::Specialisable;</span>
 <span class="coverage-no">use Red::Formatter;</span>
 <span class="coverage-no">use X::Red::Exceptions;</span>
 <span class="coverage-no">use Red::Phaser;</span>
@@ -92,6 +93,7 @@ <h1>MetamodelX::Red::Model 78.8%</h1>
 <span class="coverage-no">also does MetamodelX::Red::OnDB;</span>
 <span class="coverage-no">also does MetamodelX::Red::Id;</span>
 <span class="coverage-no">also does MetamodelX::Red::Populatable;</span>
+<span class="coverage-no">also does MetamodelX::Red::Specialisable;</span>
 <span class="coverage-no">also does Red::Formatter;</span>
 <span class="coverage-no"></span>
 <span class="coverage-no">has Attribute @!columns;</span>

diff --git a/docs/coverage/report-data/MetamodelX-Red-Specialisable.html b/docs/coverage/report-data/MetamodelX-Red-Specialisable.html
@@ -0,0 +1,105 @@
+<!DOCTYPE html>
+<html lang="en">
+<head>
+	<meta charset="UTF-8">
+	<title>RaCoCo result: MetamodelX::Red::Specialisable</title>
+	<link rel="stylesheet"
+				href="https://stackpath.bootstrapcdn.com/bootstrap/4.4.1/css/bootstrap.min.css"
+				integrity="sha384-Vkoo8x4CGsO3+Hhxv8T/Q5PaXtkKtu6ug5TOeNV6gBiFeWPGFN9MuhOf23Q9Ifjh"
+				crossorigin="anonymous">
+	<style>
+      pre.code::before {
+          counter-reset: listing;
+      }
+
+      pre.code span {
+          counter-increment: listing;
+      }
+
+      pre.code span::before {
+          content: counter(listing) ". ";
+      }
+
+      .coverage-green {
+          background-color: #32CD32;
+          /*color-blind
+          background-color: #00CED1;
+          /**/
+      }
+
+      .coverage-red {
+          background-color: #fa8072;
+      }
+
+      .coverage-purple {
+          background-color: #9370DB;
+      }
+	</style>
+</head>
+<body>
+<div class="container">
+	<div class="row mt-5 mb-3">
+		<div class="col-12">
+			<div class="page-header">
+				<h1>MetamodelX::Red::Specialisable 92.3%</h1>
+			</div>
+		</div>
+	</div>
+	<div class="row justify-content-md-center">
+		<div class="col-md-10">
+			<pre class="code">
+<span class="coverage-green">use Red::AST::MultiSelect;</span>
+<span class="coverage-no">use Red::Column;</span>
+<span class="coverage-no">use Red::Attr::Column;</span>
+<span class="coverage-no">use Red::HiddenFromSQLCommenting;</span>
+<span class="coverage-no"></span>
+<span class="coverage-green">unit role MetamodelX::Red::Specialisable;</span>
+<span class="coverage-no"></span>
+<span class="coverage-green">multi method specialise($self, +@ret where .all ~~ Red::AST) is hidden-from-sql-commenting {</span>
+<span class="coverage-green">    my \Meta  = $self.^orig.HOW.WHAT;</span>
+<span class="coverage-green">    my \model = Meta.new(:table($self.^table)).new_type: :name($self.^name);</span>
+<span class="coverage-green">    model.HOW.^attributes.first(*.name eq '$!table').set_value: model.HOW, $self.^table;</span>
+<span class="coverage-green">    my $attr-name = 'data_0';</span>
+<span class="coverage-green">    my @attrs = do for @ret {</span>
+<span class="coverage-green">        @*table-list.push: |.tables if @*table-list.defined;</span>
+<span class="coverage-green">        my $name = $self.^all.filter ~~ Red::AST::MultiSelect ?? .attr.name.substr(2) !! ++$attr-name;</span>
+<span class="coverage-green">        my $col-name = $_ ~~ Red::Column ?? .name !! $name;</span>
+<span class="coverage-green">        my $attr  = Attribute.new:</span>
+<span class="coverage-no">            :name(&quot;\$!$name&quot;),</span>
+<span class="coverage-no">            :package(model),</span>
+<span class="coverage-no">            :type(.returns ~~ Any &amp;&amp; .returns !~~ Nil ?? .returns !! Any),</span>
+<span class="coverage-no">            :has_accessor,</span>
+<span class="coverage-no">            :build(.returns),</span>
+<span class="coverage-no">        ;</span>
+<span class="coverage-green">        my %data = %(</span>
+<span class="coverage-no">            :name-alias($col-name),</span>
+<span class="coverage-no">            :name($col-name),</span>
+<span class="coverage-no">            :attr-name($name),</span>
+<span class="coverage-no">            :type(.returns.^name),</span>
+<span class="coverage-no">            :$attr,</span>
+<span class="coverage-no">            :model(.tables.head),</span>
+<span class="coverage-no">            :class(model),</span>
+<span class="coverage-green">        	|(do if $_ ~~ Red::Column {</span>
+<span class="coverage-green">                :inflate(.inflate),</span>
+<span class="coverage-no">                :deflate(.deflate),</span>
+<span class="coverage-red">            } else {</span>
+<span class="coverage-green">                :computation($_)</span>
+<span class="coverage-no">            })</span>
+<span class="coverage-no">        );</span>
+<span class="coverage-green">        $attr does Red::Attr::Column(%data);</span>
+<span class="coverage-green">        model.^add_attribute: $attr;</span>
+<span class="coverage-green">        model.^add_multi_method: $name, my method (Mu:D:) { $self.^all.get_value: &quot;\$!$name&quot; }</span>
+<span class="coverage-red">        $attr</span>
+<span class="coverage-no">    }</span>
+<span class="coverage-green">    model.^add_method: &quot;no-table&quot;, my method no-table { True }</span>
+<span class="coverage-green">    model.^add_method: &quot;orig-result-seq&quot;, my method orig-result-seq { $self.^all }</span>
+<span class="coverage-green">    model.^compose;</span>
+<span class="coverage-green">    model.^add-column: $_ for @attrs;</span>
+<span class="coverage-green">    model</span>
+<span class="coverage-no">}</span>
+			</pre>
+		</div>
+	</div>
+</div>
+</body>
+</html>
diff --git a/docs/coverage/report-data/Red-AST-Divisable.html b/docs/coverage/report-data/Red-AST-Divisable.html
@@ -41,7 +41,7 @@
 	<div class="row mt-5 mb-3">
 		<div class="col-12">
 			<div class="page-header">
-				<h1>Red::AST::Divisable 16.6%</h1>
+				<h1>Red::AST::Divisable 41.6%</h1>
 			</div>
 		</div>
 	</div>
@@ -62,9 +62,9 @@ <h1>Red::AST::Divisable 16.6%</h1>
 <span class="coverage-no"></span>
 <span class="coverage-red">method should-validate {}</span>
 <span class="coverage-no"></span>
-<span class="coverage-red">method find-column-name {</span>
-<span class="coverage-red">    for self.args {</span>
-<span class="coverage-red">        .return with .?find-column-name</span>
+<span class="coverage-green">method find-column-name {</span>
+<span class="coverage-green">    for self.args {</span>
+<span class="coverage-green">        .return with .?find-column-name</span>
 <span class="coverage-no">    }</span>
 <span class="coverage-no">}</span>
 <span class="coverage-no"></span>

diff --git a/docs/coverage/report-data/Red-AST-Infix.html b/docs/coverage/report-data/Red-AST-Infix.html
@@ -41,7 +41,7 @@
 	<div class="row mt-5 mb-3">
 		<div class="col-12">
 			<div class="page-header">
-				<h1>Red::AST::Infix 81.8%</h1>
+				<h1>Red::AST::Infix 90.9%</h1>
 			</div>
 		</div>
 	</div>
@@ -76,7 +76,7 @@ <h1>Red::AST::Infix 81.8%</h1>
 <span class="coverage-no">}</span>
 <span class="coverage-no"></span>
 <span class="coverage-green">method args { $!left, $!right }</span>
-<span class="coverage-red">method not { Red::AST::Not.new: self }</span>
+<span class="coverage-green">method not { Red::AST::Not.new: self }</span>
 <span class="coverage-green">method find-column-name { ($_ with $.left.find-column-name), ($_ with $.right.find-column-name) }</span>
 			</pre>
 		</div>

diff --git a/docs/coverage/report-data/Red-AST-Infixes.html b/docs/coverage/report-data/Red-AST-Infixes.html
@@ -41,7 +41,7 @@
 	<div class="row mt-5 mb-3">
 		<div class="col-12">
 			<div class="page-header">
-				<h1>Red::AST::Infixes 37%</h1>
+				<h1>Red::AST::Infixes 37.6%</h1>
 			</div>
 		</div>
 	</div>
@@ -78,9 +78,9 @@ <h1>Red::AST::Infixes 37%</h1>
 <span class="coverage-no"></span>
 <span class="coverage-red">    method should-validate {}</span>
 <span class="coverage-no"></span>
-<span class="coverage-red">    method find-column-name {</span>
-<span class="coverage-red">        gather for self.args {</span>
-<span class="coverage-red">            .take for .?find-column-name</span>
+<span class="coverage-green">    method find-column-name {</span>
+<span class="coverage-green">        gather for self.args {</span>
+<span class="coverage-green">            .take for .?find-column-name</span>
 <span class="coverage-no">        }</span>
 <span class="coverage-no">    }</span>
 <span class="coverage-no"></span>
@@ -395,8 +395,8 @@ <h1>Red::AST::Infixes 37%</h1>
 <span class="coverage-no"></span>
 <span class="coverage-red">    method should-validate {}</span>
 <span class="coverage-no"></span>
-<span class="coverage-green">    method not {</span>
-<span class="coverage-green">        Red::AST::In.new: $!left, $!right;</span>
+<span class="coverage-red">    method not {</span>
+<span class="coverage-red">        Red::AST::In.new: $!left, $!right;</span>
 <span class="coverage-no">    }</span>
 <span class="coverage-no">}</span>
 <span class="coverage-no"></span>

diff --git a/docs/coverage/report-data/Red-AST-Intersect.html b/docs/coverage/report-data/Red-AST-Intersect.html
@@ -65,7 +65,7 @@ <h1>Red::AST::Intersect 53.3%</h1>
 <span class="coverage-red">method args { flat @!selects&gt;&gt;.args }</span>
 <span class="coverage-no"></span>
 <span class="coverage-red">method tables(::?CLASS:D:) {</span>
-<span class="coverage-red">    (flat @!selects&gt;&gt;.tables).unique</span>
+<span class="coverage-red">    (flat @!selects».?tables).grep(-&gt; \v { v !=:= Nil }).unique</span>
 <span class="coverage-no">}</span>
 <span class="coverage-red">method find-column-name {}</span>
 <span class="coverage-no"></span>

diff --git a/docs/coverage/report-data/Red-AST-Minus.html b/docs/coverage/report-data/Red-AST-Minus.html
@@ -65,7 +65,7 @@ <h1>Red::AST::Minus 53.3%</h1>
 <span class="coverage-red">method args { flat @!selects&gt;&gt;.args }</span>
 <span class="coverage-no"></span>
 <span class="coverage-red">method tables(::?CLASS:D:) {</span>
-<span class="coverage-red">    (flat @!selects&gt;&gt;.tables).unique</span>
+<span class="coverage-red">    (flat @!selects».?tables).grep(-&gt; \v { v !=:= Nil }).unique</span>
 <span class="coverage-no">}</span>
 <span class="coverage-red">method find-column-name {}</span>
 <span class="coverage-no"></span>

diff --git a/docs/coverage/report-data/Red-AST-Select.html b/docs/coverage/report-data/Red-AST-Select.html
@@ -83,7 +83,7 @@ <h1>Red::AST::Select 76.6%</h1>
 <span class="coverage-no">}</span>
 <span class="coverage-no"></span>
 <span class="coverage-green">method tables(::?CLASS:D:) {</span>
-<span class="coverage-green">    |(|@!table-list, |(.tables with $!filter), callsame).grep(-&gt; \v { v !=:= Nil }).unique</span>
+<span class="coverage-green">    |(|@!table-list, |(.?tables with $!filter), callsame).grep(-&gt; \v { v !=:= Nil }).unique</span>
 <span class="coverage-no">}</span>
 <span class="coverage-green">method find-column-name {}</span>
 <span class="coverage-no"></span>

diff --git a/docs/coverage/report-data/Red-AST-Union.html b/docs/coverage/report-data/Red-AST-Union.html
@@ -63,7 +63,7 @@ <h1>Red::AST::Union 53.3%</h1>
 <span class="coverage-red">method args { flat @!selects&gt;&gt;.args }</span>
 <span class="coverage-no"></span>
 <span class="coverage-red">method tables(::?CLASS:D:) {</span>
-<span class="coverage-red">    (flat @!selects&gt;&gt;.tables).unique</span>
+<span class="coverage-red">    (flat @!selects».?tables).grep(-&gt; \v { v !=:= Nil }).unique</span>
 <span class="coverage-no">}</span>
 <span class="coverage-red">method find-column-name {}</span>
 <span class="coverage-no"></span>

diff --git a/docs/coverage/report-data/Red-AST-Update.html b/docs/coverage/report-data/Red-AST-Update.html
@@ -41,7 +41,7 @@
 	<div class="row mt-5 mb-3">
 		<div class="col-12">
 			<div class="page-header">
-				<h1>Red::AST::Update 71.4%</h1>
+				<h1>Red::AST::Update 73.3%</h1>
 			</div>
 		</div>
 	</div>
@@ -57,9 +57,10 @@ <h1>Red::AST::Update 71.4%</h1>
 <span class="coverage-no">#| Represents an update operation</span>
 <span class="coverage-green">unit class Red::AST::Update does Red::AST;</span>
 <span class="coverage-no"></span>
-<span class="coverage-no">has Str      $.into;</span>
-<span class="coverage-no">has Pair     @.values;</span>
-<span class="coverage-red">has Red::AST $.filter;</span>
+<span class="coverage-no">has Red::Model $.model;</span>
+<span class="coverage-green">has Str        $.into = $!model.^table;</span>
+<span class="coverage-no">has Pair       @.values;</span>
+<span class="coverage-red">has Red::AST   $.filter;</span>
 <span class="coverage-no"></span>
 <span class="coverage-red">method returns { Nil }</span>
 <span class="coverage-red">method args { |@!values, $.filter }</span>
@@ -74,7 +75,7 @@ <h1>Red::AST::Update 71.4%</h1>
 <span class="coverage-green">        X::Red::UpdateNoId.new.throw without $filter;</span>
 <span class="coverage-no"></span>
 <span class="coverage-green">        self.bless:</span>
-<span class="coverage-no">                :into(.^table),</span>
+<span class="coverage-no">                :model($_),</span>
 <span class="coverage-no">                :$filter,</span>
 <span class="coverage-no">                :@values</span>
 <span class="coverage-no">    }</span>

diff --git a/docs/coverage/report-data/Red-AST.html b/docs/coverage/report-data/Red-AST.html
@@ -41,7 +41,7 @@
 	<div class="row mt-5 mb-3">
 		<div class="col-12">
 			<div class="page-header">
-				<h1>Red::AST 74%</h1>
+				<h1>Red::AST 59.4%</h1>
 			</div>
 		</div>
 	</div>
@@ -84,24 +84,44 @@ <h1>Red::AST 74%</h1>
 <span class="coverage-no"></span>
 <span class="coverage-green">method Str { self }</span>
 <span class="coverage-no"></span>
+<span class="coverage-no">#| Find the first AST node folowing the rule</span>
+<span class="coverage-red">method transpose-first(::?CLASS:D: &amp;func) {</span>
+<span class="coverage-red">    self.transpose-grep(&amp;func).head</span>
+<span class="coverage-no">}</span>
+<span class="coverage-no"></span>
+<span class="coverage-no">#| Find AST nodes folowing the rule</span>
+<span class="coverage-green">method transpose-grep(::?CLASS:D: &amp;func) {</span>
+<span class="coverage-green">    gather {</span>
+<span class="coverage-green">        self.transpose: -&gt; $node {</span>
+<span class="coverage-green">            take $node if func $node;</span>
+<span class="coverage-red">            True</span>
+<span class="coverage-no">        }</span>
+<span class="coverage-no">    }</span>
+<span class="coverage-no">}</span>
+<span class="coverage-no"></span>
 <span class="coverage-no">#| Transposes the AST tree running the function.</span>
 <span class="coverage-green">method transpose(::?CLASS:D: &amp;func) {</span>
+<span class="coverage-green">    return unless func self;</span>
 <span class="coverage-green">    die self unless self.^can: &quot;args&quot;;</span>
 <span class="coverage-green">    for self.args.grep: Red::AST -&gt; $arg {</span>
-<span class="coverage-green">        .transpose: &amp;func with $arg</span>
+<span class="coverage-green">        next without $arg;</span>
+<span class="coverage-green">        .transpose: &amp;func with $arg;</span>
 <span class="coverage-no">    }</span>
-<span class="coverage-green">    func self;</span>
 <span class="coverage-no">}</span>
 <span class="coverage-no"></span>
 <span class="coverage-no">#| Returns a list with all the tables used on the AST</span>
 <span class="coverage-green">method tables(::?CLASS:D:) {</span>
-<span class="coverage-no">    my @tables;</span>
-<span class="coverage-green">    self.transpose: {</span>
-<span class="coverage-green">        if .^name eq &quot;Red::Column&quot; {</span>
-<span class="coverage-green">            @tables.push: .class</span>
-<span class="coverage-no">        }</span>
-<span class="coverage-no">    }</span>
-<span class="coverage-green">    |@tables.grep(-&gt; \v { v !=:= Nil }).unique</span>
+<span class="coverage-green">    |self.transpose-grep({ .^name eq &quot;Red::Column&quot; })».class.grep(-&gt; \v { v !=:= Nil }).unique;</span>
+<span class="coverage-no">}</span>
+<span class="coverage-no"></span>
+<span class="coverage-red">method replace(::?CLASS:D: Red::AST \n, Red::AST $s) {</span>
+<span class="coverage-red">    self eqv n</span>
+<span class="coverage-no">        ?? $s</span>
+<span class="coverage-no">        !! self.clone:</span>
+<span class="coverage-red">            |self.^attributes.map({</span>
+<span class="coverage-red">                my \val = .get_value(self);</span>
+<span class="coverage-red">                .name.substr(2) =&gt; val ~~ Red::AST &amp;&amp; val.DEFINITE ?? (val.?replace(n, $s) // val) !! val</span>
+<span class="coverage-no">            }).Hash</span>
 <span class="coverage-no">}</span>
 <span class="coverage-no"></span>
 <span class="coverage-green">multi method WHICH(::?CLASS:D:) {</span>