Fix and test diff

.github/workflows/matrix.yaml

@@ -13,7 +13,7 @@ jobs:
         os:
           - ubuntu-latest
         raku-version:
-          - "2022.07"
+          - "2026.07"
     runs-on: ${{ matrix.os }}
     steps:
       - uses: actions/checkout@v3

META6.json

@@ -47,11 +47,13 @@
     "Red::AST::Constraints": "lib/Red/AST/Constraints.rakumod",
     "Red::AST::CreateColumn": "lib/Red/AST/CreateColumn.rakumod",
     "Red::AST::CreateTable": "lib/Red/AST/CreateTable.rakumod",
+    "Red::AST::CreateTableCli": "lib/Red/AST/CreateTableCli.rakumod",
     "Red::AST::CreateView": "lib/Red/AST/CreateView.rakumod",
     "Red::AST::DateTimeFuncs": "lib/Red/AST/DateTimeFuncs.rakumod",
     "Red::AST::Delete": "lib/Red/AST/Delete.rakumod",
     "Red::AST::Divisible": "lib/Red/AST/Divisible.rakumod",
     "Red::AST::DropColumn": "lib/Red/AST/DropColumn.rakumod",
+    "Red::AST::DropTable": "lib/Red/AST/DropTable.rakumod",
     "Red::AST::Empty": "lib/Red/AST/Empty.rakumod",
     "Red::AST::Function": "lib/Red/AST/Function.rakumod",
     "Red::AST::Generic::Infix": "lib/Red/AST/Generic/Infix.rakumod",
@@ -88,6 +90,7 @@
     "Red::Cli::Column": "lib/Red/Cli/Column.rakumod",
     "Red::Cli::Relationship": "lib/Red/Cli/Relationship.rakumod",
     "Red::Cli::Table": "lib/Red/Cli/Table.rakumod",
+    "Red::Cli::UniqueConstraint": "lib/Red/Cli/UniqueConstraint.rakumod",
     "Red::Column": "lib/Red/Column.rakumod",
     "Red::ColumnMethods": "lib/Red/ColumnMethods.rakumod",
     "Red::Config": "lib/Red/Config.rakumod",

bin/red

@@ -1,14 +1,24 @@
 #!env perl6
+use Red;
 use Red::Cli;
 use Red::Do;
 use Red::Database;
+use Red::Configuration;
 
 my %*SUB-MAIN-OPTS =
   :named-anywhere,
 ;
 
 my $*RED-DEBUG = False;
 
+sub _config(:$config-file = "./red.rakuconfig", Bool :$debug, :$driver, *%pars) {
+    my $config         = single-config-run file => $config-file;
+    $GLOBAL::RED-DB    = $config.driver;
+    $GLOBAL::RED-DB    = database ($driver // $config.driver-name), |%pars if $driver || %pars;
+    $GLOBAL::RED-DEBUG = $debug // $config.debug;
+    $config
+}
+
 proto MAIN(Str :$I, Bool :$debug, |) {
     dyn-lib .split: "," with $I;
     $*RED-DEBUG = $debug;
@@ -18,70 +28,188 @@ proto MAIN(Str :$I, Bool :$debug, |) {
 #| List tables in database
 multi MAIN(
     "list-tables",
-    Str  :$driver!,
+    :$config-file,
+    Str  :$driver,
+    Bool :$debug,
     *%pars
 ) {
-    my $*RED-DB = database($driver, |%pars);
+    my $config = _config |(:$config-file with $config-file), |(:$debug with $debug), :$driver, |%pars;
     .say for list-tables :$driver, |%pars
 }
 
 #| Generate stub code to access models from database schema
 multi MAIN(
     "print-stub",
+    :$config-file,
     Str  :$schema-class,
-    Str  :$driver!,
+    Str  :$driver,
+    Bool :$debug,
     *%pars
 ) {
-    my $*RED-DB = database($driver, |%pars);
-    say gen-stub-code :$schema-class, :$driver, |%pars
+    my $config = _config |(:$config-file with $config-file), |(:$debug with $debug), :$driver, |%pars;
+    say gen-stub-code :$schema-class, driver => $config.driver-name, |%pars
 }
 
 
 #| Generates migration plan to upgrade database schema
 multi MAIN(
     "migration-plan",
-    Str :$model!,
+    Str :$model,
     Str :$require = $model,
-    Str :$driver!,
+    Str :$driver,
+    :I($lib-path),
+    :$config-file,
+    Bool :$debug,
     *%pars
 ) {
-    my $*RED-DB = database($driver, |%pars);
-    migration-plan :$model, :$require, :$driver, |%pars
+    "use lib '$lib-path'".EVAL;
+    my $config = _config |(:$config-file with $config-file), |(:$debug with $debug), :$driver, |%pars;
+    migration-plan model => ($model // $config.models.head), :$require, driver => $config.driver-name, |%pars
 }
 
 #| Generates models' code from database schema
 multi MAIN(
     "generate-code",
-    Str  :$path!    where { not .defined or .IO.d or $_ eq "-" or fail "Path $_ does not exist." },
-    Str  :$from-sql where { not .defined or .IO.f or $_ eq "-" or fail "SQL $_ do not exist." },
+    Str  :$path!    where { not .defined or .IO.d or $_ eq "-" },
+    Str  :$from-sql where { not .defined or .IO.f or $_ eq "-" },
     Str  :$schema-class,
     Bool :$print-stub       = False,
     Bool :$no-relationships = False,
     #Bool :$stub-only,
-    Str  :$driver!,
+    Str  :$driver,
+    :$config-file,
+    Bool :$debug,
     *%pars
 ) {
-    my $*RED-DB = database($driver, |%pars);
+    my $config = _config |(:$config-file with $config-file), |(:$debug with $debug), :$driver, |%pars;
     generate-code
-            :$path,
-            :$from-sql,
-            :$schema-class,
-            :$print-stub,
-            :$no-relationships,
-            :$driver,
-            |%pars
+        :$path,
+        :$from-sql,
+        :$schema-class,
+        :$print-stub,
+        :$no-relationships,
+        :$driver,
+        |%pars
 }
 
 #| Prepare database
 multi MAIN(
-        "prepare-database",
-        Bool :$populate,
-        Str  :$models!,
-        Str  :$driver!,
-        *%pars
+    "prepare-database",
+    Bool :$populate,
+    Str  :$models,
+    Str  :$driver,
+    :I($lib-path),
+    :$config-file,
+    Bool :$debug,
+    *%pars
+) {
+    "use lib '$lib-path'".EVAL;
+    my $config = _config |(:$config-file with $config-file), |(:$debug with $debug), :$driver, |%pars;
+    prepare-database :$populate, models => ($models // $config.models), driver => $config.driver-name, |%pars
+}
+
+multi show(@_, %attrs) {
+    qq|[ { @_.join: ", " }, ]|
+}
+multi show(IO $_,          %attrs) { qq|"{ .absolute }".IO| }
+multi show(Red::Driver $_, %attrs) {
+    qq|database "{
+        .^shortname
+    }"{
+        ", " ~ %attrs<driver-attrs>.pairs.map({
+            "{.key} => {.value.raku}"
+        }).join: ", " if %attrs<driver-attrs>:exists
+    }|
+}
+multi show(Red::Schema $_, %attrs) { qq|schema { .models.keys.join: ", " }| }
+multi show($_,             %attrs) { .raku }
+
+#| Config
+multi MAIN(
+    "config",
+    :@models,
+    :@requires = |@models,
+    :$config-file,
+    :$driver,
+    :I($lib-path),
+    Bool :$debug,
+    *%pars,
+) {
+    my %attrs =
+        models       => @models,
+        requires     => @requires,
+        driver-name  => $driver,
+        driver-attrs => %pars,
+        debug        => $debug,
+        schema       => schema(@models),
+    ;
+    my $config = _config |(:$config-file with $config-file), |(:$debug with $debug), :$driver, |%pars;
+    say "use Red;";
+    say "use Red::Config;";
+    say "use lib '{ $lib-path }';";
+    for @requires {
+        say "use $_;";
+    }
+    say "\nconfig \{";
+    for $config.^attributes -> $attr {
+        next unless $attr.has_accessor;
+        my $name = $attr.name.substr: 2;
+        say ".{ $name } = { show (%attrs{$name} // $config."$name"()), %attrs };".indent: 4
+    }
+    say "}";
+}
+
+#| Diff model from DB
+multi MAIN(
+    "diff-from-db",
+    +@models,
+    :$config-file,
+    :$driver,
+    Bool :$debug,
+    *%pars,
+) {
+    my $config = _config |(:$config-file with $config-file), |(:$debug with $debug), :$driver, |%pars;
+    say tree prepare-tree diff-from-db ( @models || $config.models );
+}
+
+#| Diff model to DB
+multi MAIN(
+    "diff-to-db",
+    +@models,
+    :$config-file,
+    :$driver,
+    Bool :$debug,
+    *%pars,
+) {
+    my $config = _config |(:$config-file with $config-file), |(:$debug with $debug), :$driver, |%pars;
+    say tree prepare-tree diff-to-db ( @models || $config.models );
+}
+
+#| Update DB with models
+multi MAIN(
+    "sync",
+    # +@models,
+    Bool :$dev where { .so },
+    :$config-file,
+    :$driver,
+    Bool :$debug,
+    *%pars,
+) {
+    my $config = _config |(:$config-file with $config-file), |(:$debug with $debug), :$driver, |%pars;
+    $config.schema.update
+}
+
+#| Update DB with models
+multi MAIN(
+    "prepare",
+    # +@models,
+    :$config-file,
+    :$driver,
+    Bool :$debug,
+    *%pars,
 ) {
-    $GLOBAL::RED-DB = database $driver, |%pars;
-    prepare-database :$populate, :$models, :$driver, |%pars
+    my $config = _config |(:$config-file with $config-file),|(:$debug with $debug), :$driver, |%pars;
+    .say for $config.schema.plan
 }
 
 sub dyn-lib(@libs) {

lib/MetamodelX/Red/Describable.rakumod

@@ -2,6 +2,7 @@ use Red::DB;
 use Red::Utils;
 use Red::Cli::Table;
 use Red::Cli::Column;
+use Red::Model;
 
 =head2 MetamodelX::Red::Describable
 
@@ -11,7 +12,7 @@ method !create-column($_ --> Red::Cli::Column) {
     Red::Cli::Column.new:
         :name(.column-name // self.column-formatter: .attr-name),
         :formated-name(.attr-name),
-        :type(get-RED-DB.default-type-for($_)),
+        :type(.type // get-RED-DB.default-type-for($_)),
         :perl-type(.type),
         :nullable(.nullable),
         :pk(.id),
@@ -21,21 +22,37 @@ 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) {
+    my @constraints = model.^unique-constraints;
     Red::Cli::Table.new: :name(self.table(model)), :model-name(self.name(model)),
-        :columns(self.columns>>.column.map({self!create-column($_)}).cache)
+        :columns(self.columns>>.column.map({self!create-column($_)}).cache),
+	:@constraints
 }
 
 #| 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
+    my Str $table = model.^table;
+    my $b = $*RED-DB.schema-reader.table-definition: $table;
+    model.^describe.diff: $b
 }
 
 #| 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
+    my $schema-reader = $*RED-DB.schema-reader;
+    my $from-db       = $schema-reader.table-definition: model.^table;
+    $from-db.diff: model.^describe
 }
 
 #| Returns the difference between two models.
-method diff(\model, \other-model) {
-    model.^describe.diff: other-model.^describe
+multi method diff(\model, Red::Model \other-model) {
+    model.^diff: other-model.^describe
+}
+
+#| Returns the difference between two models.
+multi method diff(\model, Red::Cli::Table \other-model) {
+    model.^describe.diff: other-model
+}
+
+#| Returns the difference between two models.
+multi method diff(\model, \other-model) {
+    model.^describe.diff: other-model
 }

lib/Red/AST/CreateTableCli.rakumod

@@ -0,0 +1,11 @@
+use Red::AST;
+use Red::Cli::Table;
+
+#| Represents a create table
+unit class Red::AST::CreateTableCli does Red::AST;
+
+has Red::Cli::Table $.table;
+
+method returns { Nil }
+method args { |$!table.columns }
+method find-column-name {}

lib/Red/AST/DropTable.rakumod

@@ -0,0 +1,10 @@
+use Red::AST;
+
+#| Represents an alter table drop column
+unit class Red::AST::DropTable does Red::AST;
+
+has Str  $.table is required;
+
+method find-column-name {}
+method args {}
+method returns {}