New step on red-migration. Related to #15

META6.json

@@ -91,6 +91,7 @@
     "Red::Column": "lib/Red/Column.rakumod",
     "Red::ColumnMethods": "lib/Red/ColumnMethods.rakumod",
     "Red::Config": "lib/Red/Config.rakumod",
+    "Red::Configuration": "lib/Red/Configuration.rakumod",
     "Red::DB": "lib/Red/DB.rakumod",
     "Red::Database": "lib/Red/Database.rakumod",
     "Red::DefaultResultSeq": "lib/Red/DefaultResultSeq.rakumod",

bin/red

@@ -1,31 +1,76 @@
 #!env raku
 use Red::Cli;
 use Red::Do;
+use Red::DB;
 use Red::Database;
 use Red::Configuration;
 
 my %*SUB-MAIN-OPTS =
   :named-anywhere,
 ;
 
-my $*RED-DEBUG = False;
+my $*RED-DEBUG;
 
-proto MAIN(Str :$I, Bool :$debug, IO() :$config = $*CWD.add("migration.rakuconfig"), |) {
+proto MAIN(Str :$I, Bool :$debug,:$driver, IO() :$config = $*CWD.add("migration.rakuconfig"), |) {
     dyn-lib .split: "," with $I;
     my $*config = single-config-run :file($config);
     $*RED-DEBUG = $debug;
     {*}
 }
 
+#| Show model versions
 multi MAIN(
     "migration",
-    "update"
+    "model-versions",
+    *%pars,
 ) {
-    note "dump DB into { $*config.new-dump-version-path.relative }";
-    note "calculate the differences between the DB and the models and create high level changes file on { $*config.migration-red-path.relative }";
-    note "apply  changes file on { $*config.migration-red-path.relative } on local DB";
-    note "copy changed models files to new dir inside { $*config.model-storage-path.relative }"
+    my UInt $size = $*config.models-cache.keys>>.chars.max;
+    say "Models:";
+    for $*config.models-cache.kv -> Str() $model, IO() $path {
+        printf "\t%{ -$size }s => %s\n", $model, $path.relative
+    }
 }
+
+#| Update DB based on the model and create highlevel objects about those changes
+multi MAIN(
+    "migration",
+    "update",
+    :$driver!,
+    :$models,
+    :$requires = $models,
+    *%pars,
+) {
+    red-defaults $driver, |%pars with $driver;
+    my $path = $*config.new-dump-version-path;
+    $path.parent.mkdir;
+    note "dump DB into { $path.relative }";
+    get-RED-DB.dump: $path.relative;
+
+    note "calculate the differences between the DB";
+    my @reqs = $requires.comb(/<-[,]>+/);
+    require ::($requires); # FIXME: loop over @reqs
+
+    my @asts;
+
+    for get-RED-DB.diff-to-ast: ::($models).^diff-from-db<> -> @data {
+        @asts.append: @data;
+    }
+    note "The models and create high level changes file on { $*config.migration-red-path.relative }";
+    # TODO: create high level way
+    note "apply changes file on { $*config.migration-red-path.relative } on local DB";
+    get-RED-DB.execute: $_ for @asts;
+}
+
+#| Redo transformation based on highlevel object (that could have been changed)
+multi MAIN(
+    "migration",
+    "redo-update"
+) {
+    note "restore dump from { $*config.dump-version-path.relative }";
+    note "exec highlevel changes from { $*config.migration-red-path.relative }"
+}
+
+#| Revert to the state before the last update
 multi MAIN(
     "migration",
     "revert-update"
@@ -36,14 +81,26 @@ multi MAIN(
     note "delete models from { $*config.model-storage-path.relative }"
 }
 
+#| Create (SQL) migration based on current DB state compared to last applied model
 multi MAIN(
     "migration",
-    "prepare"
+    "prepare",
+    :$driver!,
+    :$models,
+    :$requires = $models,
+    *%pars,
 ) {
-    note "convert high lavel DB change from { $*config.migration-red-path.relative } into SQL on { $*config.drivers.map({ $*config.migration-sql-path($_).relative }).join: " and " }";
+    red-defaults $driver, |%pars with $driver;
+    require ::($requires); # FIXME: loop over @reqs
+    note "copy changed models files to new dir inside { $*config.model-storage-path.relative }";
+    my $orig-path = ::($models).^methods(:local).head.file.split(/\s/).head;
+    $*config.copy-model: $orig-path;
+    # note "Model copied to { $new-path.relative }"
+    note "create SQL to transform the last version of model into current state of the DB on { $*config.drivers.map({ $*config.migration-sql-path($_).relative }).join: " and " }";
     note "delete all dumps on { $*config.dump-storage-path.relative }";
 }
 
+#| Apply SQL (possibly changed) into prod DB
 multi MAIN(
     "migration",
     "apply",

lib/MetamodelX/Red/Describable.rakumod

@@ -7,8 +7,9 @@ use Red::Cli::Column;
 
 unit role MetamodelX::Red::Describable;
 
-method !create-column($_ --> Red::Cli::Column) {
+method !create-column($_, \model --> Red::Cli::Column) {
     Red::Cli::Column.new:
+        :model(model),
         :name(.column-name // self.column-formatter: .attr-name),
         :formated-name(.attr-name),
         :type(get-RED-DB.default-type-for($_)),
@@ -21,18 +22,23 @@ method !create-column($_ --> Red::Cli::Column) {
 #| Returns an object of type `Red::Cli::Table` that represents
 #| a database table of the caller.
 method describe(\model --> Red::Cli::Table) {
-    Red::Cli::Table.new: :name(self.table(model)), :model-name(self.name(model)),
-        :columns(self.columns>>.column.map({self!create-column($_)}).cache)
+    Red::Cli::Table.new:
+        :model(model),
+        :name(self.table(model)),
+        :model-name(self.name(model)),
+        :columns(
+            self.columns>>.column.map({self!create-column($_, model)}).cache
+        )
 }
 
 #| Returns the difference to transform this model to the database version.
 method diff-to-db(\model) {
-    model.^describe.diff: $*RED-DB.schema-reader.table-definition: model.^table
+    model.^describe.diff: get-RED-DB.schema-reader.table-definition: model.^table
 }
 
 #| Returns the difference to transform the DB table into this model.
 method diff-from-db(\model) {
-    $*RED-DB.schema-reader.table-definition(model.^table).diff: model.^describe
+    get-RED-DB.schema-reader.table-definition(model.^table).diff: model.^describe
 }
 
 #| Returns the difference between two models.

lib/Red/AST/CreateTable.rakumod

@@ -8,7 +8,7 @@ unit class Red::AST::CreateTable does Red::AST;
 
 has Str                     $.name;
 has Bool                    $.temp;
-has Red::Column             @.columns;
+has Red::Column()           @.columns;
 has Red::AST::Constraint    @.constraints;
 has Red::AST::TableComment  $.comment;
 

lib/Red/Cli.rakumod

@@ -1,5 +1,6 @@
 unit class Red::Cli;
 use Red::Database;
+use Red::DB;
 use Red::Do;
 use Red::Schema;
 use Red::Utils;
@@ -13,7 +14,7 @@ multi list-tables(
         Str  :$driver!,
         *%pars
 ) is export {
-    my $schema-reader = $*RED-DB.schema-reader;
+    my $schema-reader = get-RED-DB.schema-reader;
 
     $schema-reader.tables-names.do-it
 }
@@ -38,7 +39,7 @@ multi gen-stub-code(
         Str  :$driver!,
         *%pars
 ) is export {
-    my $schema-reader = $*RED-DB.schema-reader;
+    my $schema-reader = get-RED-DB.schema-reader;
 
     my @includes;
     my @models;
@@ -65,11 +66,11 @@ multi migration-plan(
 ) is export {
     my %steps;
     require ::($require);
-    for $*RED-DB.diff-to-ast: ::($model).^diff-from-db -> @data {
+    for get-RED-DB.diff-to-ast: ::($model).^diff-from-db -> @data {
         say "Step ", ++$, ":";
         #say @data.join("\n").indent: 4
-        #        $*RED-DB.translate($_).key.indent(4).say for Red::AST::ChangeColumn.optimize: @data
-        $*RED-DB.translate($_).key.indent(4).say for @data
+        #        get-RED-DB.translate($_).key.indent(4).say for Red::AST::ChangeColumn.optimize: @data
+        get-RED-DB.translate($_).key.indent(4).say for @data
     }
 }
 
@@ -84,7 +85,7 @@ multi generate-code(
         Str  :$driver!,
         *%pars
 ) is export {
-    my $schema-reader = $*RED-DB.schema-reader;
+    my $schema-reader = get-RED-DB.schema-reader;
 
     my $schema = do if $path eq "-" {
         $*OUT

lib/Red/Cli/Column.rakumod

@@ -2,15 +2,17 @@ use Red::Utils;
 use Red::DB;
 unit class Red::Cli::Column;
 
+# TODO: missing autoincrement?
 has      $.table      is rw;
 has Str  $.name       is required;
 has Str  $.formated-name = snake-to-kebab-case $!name;
 has Str  $.type       is required;
-has Str  $.perl-type  = get-RED-DB.type-for-sql: $!type.lc;
+has Str  $.perl-type  = get-RED-DB.type-for-sql: $!type.lc; # FIXME: raku-type?
 has Bool $.nullable   = True;
 has Bool $.pk         = False;
 has Bool $.unique     = False;
 has      $.references = {};
+has      $.model;
 
 multi method new($name, $type, $nullable, $pk, $unique, $references) {
     self.bless: :$name, :$type, :nullble(?$nullable), :pk(?$pk), :unique(?$unique), :$references

lib/Red/Cli/Table.rakumod

@@ -8,6 +8,7 @@ has Str  $.model-name = try { snake-to-camel-case $!name };
 has      @.columns;
 has      @.relationships;
 has Bool $.exists = True;
+has      $.model;
 
 submethod TWEAK(:@columns) {
     for @columns -> $col {
@@ -39,9 +40,16 @@ method to-code(Str :$schema-class, Bool :$no-relationships) {
 
 method diff(::?CLASS $b) {
     my @diffs;
-    if $!name ne $b.name {
+    if !$!name.defined && !$b.name.defined {
+        die "Should this be happening???";
+    } elsif !$!name.defined {
+        return [[ "+", "table", $b.name, $b.columns<> ],];
+    } elsif !$b.name.defined {
+        return [[ "-", "table", $!name ],];
+    }
+    if $!name // "" ne $b.name // "" {
         @diffs.push: [ $!name, "+", "name", $b.name ];
-        @diffs.push: [ $!name, "-", "name", $!name  ];
+        @diffs.push: [ $!name, "-", "name", $!name  ] without $!name;
     }
     if @!columns != $b.columns {
         @diffs.push: [ $!name, "+", "n-of-cols", $b.columns.elems ];

lib/Red/ColumnMethods.rakumod

@@ -6,12 +6,22 @@ use Red::AST::DateTimeFuncs;
 use Red::AST::JsonItem;
 use Red::AST::JsonRemoveItem;
 use Red::Type::Json;
+use Red::Cli::Column;
 
 =head2 Red::ColumnMethods
 
 #| Red::Column methods
 unit role Red::ColumnMethods;
 
+multi method new(Red::Cli::Column $_) {
+    ::?CLASS.new:
+        :attr(Attribute.new: :name("\$!{.name}"), :package(.model), :type(.perl-type)),
+        :id(.pk),
+        # :references(.references),
+        :nullable(.nullable),
+        :type(.type),
+}
+
 #| Tests if that column value starts with a specific sub-string
 #| is usually translated for SQL as `column like 'substr%'`
 multi method starts-with(Str() $text is readonly) {