diff --git a/META6.json b/META6.json index b32eb916..8187090c 100644 --- a/META6.json +++ b/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", @@ -113,6 +114,7 @@ "Red::FromRelationship": "lib/Red/FromRelationship.rakumod", "Red::HiddenFromSQLCommenting": "lib/Red/HiddenFromSQLCommenting.rakumod", "Red::LockType": "lib/Red/LockType.rakumod", + "Red::Migration::Applied": "lib/Red/Migration/Applied.rakumod", "Red::Migration::Column": "lib/Red/Migration/Column.rakumod", "Red::Migration::Migration": "lib/Red/Migration/Migration.rakumod", "Red::Migration::Table": "lib/Red/Migration/Table.rakumod", diff --git a/bin/red b/bin/red index 850a6feb..4ddc4236 100755 --- a/bin/red +++ b/bin/red @@ -1,7 +1,9 @@ -#!env perl6 +#!/usr/bin/env raku use Red::Cli; use Red::Do; +use Red::DB; use Red::Database; +use Red::Configuration; my %*SUB-MAIN-OPTS = :named-anywhere, @@ -36,7 +38,6 @@ multi MAIN( say gen-stub-code :$schema-class, :$driver, |%pars } - #| Generates migration plan to upgrade database schema multi MAIN( "migration-plan", @@ -57,7 +58,6 @@ multi MAIN( Str :$schema-class, Bool :$print-stub = False, Bool :$no-relationships = False, - #Bool :$stub-only, Str :$driver!, *%pars ) { @@ -84,6 +84,58 @@ multi MAIN( prepare-database :$populate, :$models, :$driver, |%pars } +#============================================ +# MIGRATION COMMANDS +#============================================ + +#| Update local DB to match model, save model snapshot for future diffs +multi MAIN( + "migration", + "update", + Str :$model!, + Str :$require = $model, + Str :$driver!, + *%pars +) { + $GLOBAL::RED-DB = database($driver, |%pars); + migration-update :$model, :$require, :$driver, |%pars; +} + +#| Rollback the last applied migration on the local DB +multi MAIN( + "migration", + "downgrade", + Str :$driver!, + *%pars +) { + $GLOBAL::RED-DB = database($driver, |%pars); + migration-downgrade :$driver, |%pars; +} + +#| Generate SQL migration files (up.sql + down.sql) from model snapshots +multi MAIN( + "migration", + "prepare", + Str :$model!, + Str :$require = $model, + Str :$driver!, + *%pars +) { + $GLOBAL::RED-DB = database($driver, |%pars); + migration-prepare :$model, :$require, :$driver, |%pars; +} + +#| Apply pending SQL migrations to the target database +multi MAIN( + "migration", + "apply", + Str :$driver!, + *%pars +) { + $GLOBAL::RED-DB = database($driver, |%pars); + migration-apply :$driver, |%pars; +} + sub dyn-lib(@libs) { - qq[use lib "{ $_ }"].EVAL for @libs + qq[use lib "{ $_ }"].EVAL for @libs } diff --git a/lib/Red/Cli.rakumod b/lib/Red/Cli.rakumod index fe3ba234..1b018665 100644 --- a/lib/Red/Cli.rakumod +++ b/lib/Red/Cli.rakumod @@ -1,20 +1,21 @@ unit class Red::Cli; use Red::Database; +use Red::DB; use Red::Do; use Red::Schema; use Red::Utils; use Red::AST::CreateColumn; use Red::AST::ChangeColumn; use Red::AST::DropColumn; - +use Red::AST::CreateTable; +use Red::Configuration; #| Lists tables from database schema 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 } @@ -24,7 +25,7 @@ sub gen-stub(:@includes, :@models, :$driver, :%pars) { for @includes.unique { @stub.push: "use $_;" } - @stub.push: "\nred-defaults \"{ $driver }\", { %pars.map(*.perl) };"; + @stub.push: "\nred-defaults \"{ $driver }\", { %pars.map(*.raku) };\n"; @stub.push: ""; for @models { @stub.push: ".say for { $_ }.^all;" @@ -38,8 +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; for $schema-reader.tables-names -> $table-name { @@ -51,11 +51,9 @@ multi gen-stub-code( @includes.push: $model-name; } } - gen-stub(:@includes, :@models, :$driver, :%pars).join: "\n" } - #| Generates migration plan to upgrade database schema multi migration-plan( Str :$model!, @@ -63,13 +61,10 @@ multi migration-plan( Str :$driver!, *%pars ) 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 @data } } @@ -80,11 +75,10 @@ multi generate-code( Str :$schema-class, Bool :$print-stub = False, Bool :$no-relationships = False, - #Bool :$stub-only, 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 @@ -144,3 +138,288 @@ multi prepare-database( my @m = schema($models.split: ",").create.models.values; @m.map: { .^populate } if $populate } + +#============================================ +# MIGRATION COMMANDS +#============================================ + +#| Update the local database to match the current model definitions. +#| Saves a snapshot of the current model for later diffing. +multi migration-update( + Str :$model!, + Str :$require = $model, + Str :$driver!, + Str :$config-path = "migration.rakuconfig", + *%pars +) is export { + my $config = Red::Configuration.new: + :base-path($*CWD), + :drivers[$driver], + ; + $config.ensure-dirs; + + require ::($require); + + my $model-class = ::($model); + my $model-name = $model-class.^name; + my $table-name = $model-class.^table; + + # 1. Compute the diff between DB and model FIRST — avoid creating empty versions + my @diffs = $model-class.^diff-from-db; + unless @diffs { + note "No changes detected for $model-name (table: $table-name)"; + return; + } + + # 2. Allocate new version only when there are actual changes + my $version = $config.current-version + 1; + $config.store-version: $version, "update $model-name"; + + # 3. Convert diffs to AST + my @asts; + for get-RED-DB.diff-to-ast(@diffs) -> @data { + @asts.append: @data; + } + + # 4. Apply each AST to the local DB + for @asts -> $ast { + note "Applying: { get-RED-DB.translate($ast).key }"; + get-RED-DB.execute: $ast; + } + + # 5. Save model description snapshot as JSON (for future prepare) + use JSON::Fast; + my $desc = $model-class.^describe; + my $snapshot-path = $config.model-storage-path.add: "{ $model-name }-{ $version }.json"; + $snapshot-path.spurt: to-json(:!pretty, $desc.to-hash); + + # 6. Update current version + $config.current-version = $version; + $config.version-dir($version).add("config.rakudata").spurt: $config.raku; + + note "Migration v{ $version } applied. Snapshot saved to { $snapshot-path.relative($*CWD) }"; + $version +} + +#| Downgrade the local database by restoring from a dump file. +#| Note: currently requires manual dump management; focuses on schema rollback. +multi migration-downgrade( + Str :$driver!, + Str :$config-path = "migration.rakuconfig", + *%pars +) is export { + my $config = Red::Configuration.new: + :base-path($*CWD), + :drivers[$driver], + ; + + my $version = $config.current-version; + if $version < 1 { + note "No migrations to downgrade (current version: $version)"; + return; + } + + note "Downgrading from version $version..."; + + # Apply the down.sql for the current version + for $config.drivers -> $drv { + my $down-file = $config.down-sql($drv, $version); + if $down-file.f { + note "Running down migration: { $down-file.relative($*CWD) }"; + for $down-file.lines -> $sql { + next if $sql.trim eq '' || $sql.trim.starts-with('--'); + get-RED-DB.execute: $sql; + } + } else { + note "No down.sql found for $drv v$version"; + } + } + + $config.current-version = $version - 1; + note "Downgraded to version { $config.current-version }"; +} + +#| Generate SQL migration files (up.sql and down.sql) by comparing +#| the versioned model snapshot with the current model definition. +multi migration-prepare( + Str :$model!, + Str :$require = $model, + Str :$driver!, + Str :$config-path = "migration.rakuconfig", + *%pars +) is export { + my $config = Red::Configuration.new: + :base-path($*CWD), + :drivers[$driver], + ; + $config.ensure-dirs; + + require ::($require); + my $model-class = ::($model); + my $model-name = $model-class.^name; + + # 1. Find the latest model snapshot (JSON format) + my @snapshots = $config.model-storage-path.dir + .grep: { .basename.starts-with($model-name ~ '-') && .extension eq 'json' } + .sort: { .modified } + ; + + unless @snapshots { + note "No previous model snapshot found for $model-name."; + note "Run 'red migration update' first to create a snapshot, or create an initial SQL file manually."; + return; + } + + my $snapshot-file = @snapshots.tail; + note "Using snapshot: { $snapshot-file.relative($*CWD) }"; + + # 2. Load the old model description from JSON snapshot + use JSON::Fast; + my $old-hash = from-json $snapshot-file.slurp; + my $old-desc = Red::Cli::Table.from-hash: $old-hash; + + # 3. Get current model description + my $new-desc = $model-class.^describe; + + # 4. Compute diffs + my @up-diffs = $old-desc.diff: $new-desc; # old → new + my @down-diffs = $new-desc.diff: $old-desc; # new → old + + # 5. Generate SQL for each driver + my $version = $config.current-version + 1; + for $config.drivers -> $drv { + # Temporarily set up the driver for translation + my $*RED-DB = database($drv, |%pars); + + # Generate up.sql + my $up-dir = $config.sql-dir-for($drv, $version); + $up-dir.mkdir: :p; + my $up-file = $config.up-sql($drv, $version); + my $up-fh = $up-file.open: :w; + $up-fh.say: "-- Red Migration v$version: $model-name (UP)"; + $up-fh.say: "-- Generated: { DateTime.now }"; + $up-fh.say: "-- Driver: $drv"; + $up-fh.say: ""; + if @up-diffs { + my @asts; + for $*RED-DB.diff-to-ast(@up-diffs) -> @data { + @asts.append: @data; + } + for @asts -> $ast { + my ($sql, @bind) = $*RED-DB.translate($ast).kv; + $up-fh.say: "$sql;" if $sql; + } + } else { + $up-fh.say: "-- No schema changes"; + } + $up-fh.close; + note "Generated: { $up-file.relative($*CWD) }"; + + # Generate down.sql + my $down-file = $config.down-sql($drv, $version); + my $down-fh = $down-file.open: :w; + $down-fh.say: "-- Red Migration v$version: $model-name (DOWN)"; + $down-fh.say: "-- Generated: { DateTime.now }"; + $down-fh.say: "-- Driver: $drv"; + $down-fh.say: ""; + if @down-diffs { + my @asts; + for $*RED-DB.diff-to-ast(@down-diffs) -> @data { + @asts.append: @data; + } + for @asts -> $ast { + my ($sql, @bind) = $*RED-DB.translate($ast).kv; + $down-fh.say: "$sql;" if $sql; + } + } else { + $down-fh.say: "-- No schema changes"; + } + $down-fh.close; + note "Generated: { $down-file.relative($*CWD) }"; + } + + $config.store-version: $version, "prepare $model-name"; + note "Migration v$version prepared successfully."; +} + +#| Apply pending SQL migrations to the target database. +#| Reads the version from a tracking table and applies all newer up.sql files. +multi migration-apply( + Str :$driver!, + Str :$config-path = "migration.rakuconfig", + *%pars +) is export { + my $config = Red::Configuration.new: + :base-path($*CWD), + :drivers[$driver], + ; + + # 1. Ensure the migration tracking table exists + ensure-migration-table($config); + + # 2. Read current version from DB + my $db-version = get-applied-version($config); + + # 3. Find all pending up.sql files + my @pending; + for $config.version-storage-path.dir(:test(*.d)).sort(*.basename.Int) -> $dir { + my $ver = $dir.basename.Int; + next if $ver <= $db-version; + my $up-file = $config.up-sql($driver, $ver); + if $up-file.f { + @pending.push: %(:$ver, :file($up-file)); + } + } + + unless @pending { + note "Database is up to date (version: $db-version)"; + return; + } + + # 4. Apply each pending migration in a transaction + for @pending -> %m { + my $ver = %m; + my $file = %m; + note "Applying migration v$ver: { $file.relative($*CWD) }"; + + get-RED-DB.execute: "BEGIN"; + for $file.lines -> $sql { + my $trimmed = $sql.trim; + next if $trimmed eq '' || $trimmed.starts-with('--'); + get-RED-DB.execute: $trimmed; + } + # Record the migration + record-migration($config, $ver, $file.basename); + get-RED-DB.execute: "COMMIT"; + note " ✓ Migration v$ver applied successfully."; + CATCH { + default { + note " ✗ Migration v$ver FAILED: { .message }"; + get-RED-DB.execute: "ROLLBACK"; + die "Migration v$ver failed. Aborting."; + } + } + } + + my $new-version = @pending.tail; + note "Database migrated to version $new-version."; +} + +#| Ensure the migration tracking table exists in the database. +sub ensure-migration-table(Red::Configuration $config) { + use Red::Migration::Applied; + Red::Migration::Applied.^create-table; +} + +#| Get the currently applied migration version from the DB. +sub get-applied-version(Red::Configuration $config --> UInt) { + use Red::Migration::Applied; + my @applied = Red::Migration::Applied.^all; + @applied ?? @applied.map(*.version).max !! 0 +} + +#| Record that a migration was applied. +sub record-migration(Red::Configuration $config, UInt $version, Str $name) { + use Red::Migration::Applied; + Red::Migration::Applied.^create: :$version, :$name; +} diff --git a/lib/Red/Cli/Column.rakumod b/lib/Red/Cli/Column.rakumod index b2f68235..e7639080 100644 --- a/lib/Red/Cli/Column.rakumod +++ b/lib/Red/Cli/Column.rakumod @@ -84,3 +84,29 @@ method diff(::?CLASS $b) { } @diffs } + +#| Serialize to a JSON-safe Hash (no circular table reference). +method to-hash(--> Hash) { + %( + :name($!name), + :type($!type), + :perl-type($!perl-type), + :nullable($!nullable), + :pk($!pk), + :unique($!unique), + :references($!references.Hash), + ) +} + +#| Deserialize from a Hash produced by to-hash. +multi method from-hash(::?CLASS:U: Hash $h --> ::?CLASS) { + self.new: + :name($h), + :type($h), + :perl-type($h // Str), + :nullable($h // True), + :pk($h // False), + :unique($h // False), + :references($h // {}), + ; +} diff --git a/lib/Red/Cli/Table.rakumod b/lib/Red/Cli/Table.rakumod index a467951f..7ac9bd88 100644 --- a/lib/Red/Cli/Table.rakumod +++ b/lib/Red/Cli/Table.rakumod @@ -67,3 +67,23 @@ method diff(::?CLASS $b) { @diffs.push: [ $!name, "-", "col", $_ ] for @a; @diffs } + +#| Serialize to a JSON-safe Hash (no circular references). +method to-hash(--> Hash) { + %( + :name($!name), + :model-name($!model-name), + :columns[ @!columns.map: *.to-hash ], + :$!exists, + ) +} + +#| Deserialize from a Hash produced by to-hash. +multi method from-hash(::?CLASS:U: Hash $h --> ::?CLASS) { + self.new: + :name($h), + :model-name($h // try { snake-to-camel-case $h }), + :columns[ $h.map: { Red::Cli::Column.from-hash($_) } ], + :exists($h // True), + ; +} diff --git a/lib/Red/Column.rakumod b/lib/Red/Column.rakumod index 62efb783..f0e49188 100644 --- a/lib/Red/Column.rakumod +++ b/lib/Red/Column.rakumod @@ -71,7 +71,7 @@ multi method perl(::?CLASS:D:) { "{ self.^name }.new({ self.Hash.pairs.sort.map(-> (:$key, :$value) { next if $key eq .one; - "$key.Str() => $value.perl()" + "$key.Str() => $value.raku()" }).join: ", " })" } diff --git a/lib/Red/Configuration.rakumod b/lib/Red/Configuration.rakumod new file mode 100644 index 00000000..10e0486c --- /dev/null +++ b/lib/Red/Configuration.rakumod @@ -0,0 +1,85 @@ +#| Manages migration paths, versions, and model snapshots for Red migrations. +class Red::Configuration { + +#| Base project directory (where META6.json lives) +has IO() $.base-path = $*CWD; +#| Root directory for all migration artifacts +has IO() $.migration-base-path = $!base-path.add: "migrations"; +#| Where model snapshots are stored (versioned copies of .rakumod files) +has IO() $.model-storage-path = $!migration-base-path.add: "models"; +#| Where migration version directories live (each version gets a subdir) +has IO() $.version-storage-path = $!migration-base-path.add: "versions"; +#| Where SQL migration files are stored (per driver) +has IO() $.sql-storage-path = $!migration-base-path.add: "sql"; +#| Subdirectory name for SQL files within each version +has Str $.sql-subdir = "sql"; +#| The current migration version (read from DB or tracking table) +has UInt $.current-version is rw = 0; +#| Supported database drivers (used to generate driver-specific SQL) +has Str @.drivers = ; + +#| Resolve the version directory for a given version number +method version-dir(UInt $version --> IO::Path) { + $!version-storage-path.add: $version.Str +} + +#| Resolve the SQL directory for a given driver (uses current version) +method sql-dir(Str $driver --> IO::Path) { + self.version-dir($!current-version).add: $!sql-subdir, $driver +} + +#| Resolve the SQL directory for a given version and driver +method sql-dir-for(Str $driver, UInt $version --> IO::Path) { + self.version-dir($version).add: $!sql-subdir, $driver +} + +#| Resolve the global SQL storage path for a driver +method global-sql-dir(Str $driver --> IO::Path) { + $!sql-storage-path.add: $driver +} + +#| Path to the up.sql file for a given driver and version +method up-sql(Str $driver, UInt $version --> IO::Path) { + self.sql-dir-for($driver, $version).add: "up.sql" +} + +#| Path to the down.sql file for a given driver and version +method down-sql(Str $driver, UInt $version --> IO::Path) { + self.sql-dir-for($driver, $version).add: "down.sql" +} + +#| Path to the global up.sql for a driver (non-versioned, apply-all style) +method global-up-sql(Str $driver --> IO::Path) { + self.global-sql-dir($driver).add: "up.sql" +} + +#| Path to the global down.sql for a driver +method global-down-sql(Str $driver --> IO::Path) { + self.global-sql-dir($driver).add: "down.sql" +} + +#| Store a snapshot of a model file into the versioned model storage. +#| Uses a microsecond timestamp + random suffix for unique, ordered filenames. +#| Returns the path where it was stored. +method store-model(IO() $source-file, Str $model-name --> IO::Path) { + $!model-storage-path.mkdir: :p; + my $suffix = (now * 1_000_000).Int ~ '-' ~ (^0xFFFF).pick.fmt('%04x'); + my $dest = $!model-storage-path.add: "{ $model-name }-{ $suffix }.rakumod"; + $source-file.copy: $dest; + $dest +} + +#| Store version info for a migration step. +method store-version(UInt $version, Str $description = "") { + my $dir = self.version-dir: $version; + $dir.mkdir; + $dir.add("info.txt").spurt: "version: $version\ncreated: { DateTime.now }\ndescription: $description\n"; +} + +#| Ensure all required directories exist. +method ensure-dirs() { + .mkdir for $!migration-base-path, $!model-storage-path, + $!version-storage-path, $!sql-storage-path; + self +} +} \ No newline at end of file diff --git a/lib/Red/Driver.rakumod b/lib/Red/Driver.rakumod index e1e28acd..24091a4e 100644 --- a/lib/Red/Driver.rakumod +++ b/lib/Red/Driver.rakumod @@ -122,7 +122,7 @@ method optimize(Red::AST $in --> Red::AST) { $in } multi method debug(@bind) { if $*RED-DEBUG { - note "BIND: @bind.perl()"; + note "BIND: @bind.raku()"; } } @@ -135,6 +135,6 @@ multi method debug($sql) { multi method debug($sql, @binds) { if $*RED-DEBUG { note "SQL : $sql"; - note "BIND: @binds.perl()"; + note "BIND: @binds.raku()"; } } diff --git a/lib/Red/Driver/Mock.rakumod b/lib/Red/Driver/Mock.rakumod index 7dedd083..4de895ca 100644 --- a/lib/Red/Driver/Mock.rakumod +++ b/lib/Red/Driver/Mock.rakumod @@ -132,7 +132,7 @@ method verify { #is test-assertion { for %!when-re.kv -> Regex $re, % (:$counter = 0, :$times, |) { ok ($times == Inf or $counter == $times), - "Query that matches '$re.perl()' should be called $times times and was called $counter time(s)"; + "Query that matches '$re.raku()' should be called $times times and was called $counter time(s)"; } }, "Red Mock verify" } diff --git a/lib/Red/Migration/Applied.rakumod b/lib/Red/Migration/Applied.rakumod new file mode 100644 index 00000000..9d718634 --- /dev/null +++ b/lib/Red/Migration/Applied.rakumod @@ -0,0 +1,10 @@ +use Red; + +#| Tracks which migrations have been applied to a database. +#| Used by `red migration apply` to know which up.sql files to run. +unit model Red::Migration::Applied is table; + +has UInt $.id is serial; +has UInt $.version is column{ :unique, :!nullable }; +has Str $.name is column{ :!nullable }; +has DateTime $.applied-at is column = DateTime.now; diff --git a/lib/Red/Model.rakumod b/lib/Red/Model.rakumod index 5f0e114a..d1855ff9 100644 --- a/lib/Red/Model.rakumod +++ b/lib/Red/Model.rakumod @@ -12,7 +12,7 @@ multi method perl(::?CLASS:D:) { self.raku } multi method raku(::?CLASS:D:) { my @attrs = self.^attributes.grep({ !.^can("relationship-ast") && .has_accessor}).map: { - "{ .name.substr(2) } => { .get_value(self).perl }" + "{ .name.substr(2) } => { .get_value(self).raku }" } "{ self.^name }.new({ @attrs.join: ", " })" } diff --git a/lib/X/Red/Exceptions.rakumod b/lib/X/Red/Exceptions.rakumod index 5a6cf8d3..1dfb05fd 100644 --- a/lib/X/Red/Exceptions.rakumod +++ b/lib/X/Red/Exceptions.rakumod @@ -89,7 +89,7 @@ class X::Red::Driver::Mapped::UnknownError is X::Red::Driver::Mapped { Unknown Error!!! Please, copy this backtrace and open an issue on https://github.com/FCO/Red/issues/new Driver: { $.driver } - Original error: { $.orig-exception.perl } + Original error: { $.orig-exception.raku } END } } diff --git a/t/78-migration.rakutest b/t/78-migration.rakutest new file mode 100644 index 00000000..471166be --- /dev/null +++ b/t/78-migration.rakutest @@ -0,0 +1,162 @@ +use Test; +use Red; +use Red::Cli; +use Red::Do; +use Red::Configuration; +use Red::DB; + +# ============================================ +# RED tests — verify migration detection works +# ============================================ + +my $*RED-DB = database "SQLite", :database<:memory:>; +my $*RED-DEBUG = False; + +# Use a unique per-test temp directory to avoid collisions in parallel test runs +my $tmp-base = $*TMPDIR.add: "red-migration-test-{ $*PID }-{ now.Int }"; +$tmp-base.mkdir: :p; +LEAVE { try $tmp-base.IO.rmdir: :r } # cleanup on exit + +# --- Define models --- +model PersonV1 { + has UInt $.id is serial; + has Str $.name is column; +} + +# --- Test 1: diff-from-db after create-table --- +PersonV1.^create-table; +my @diffs = PersonV1.^diff-from-db; +# Note: ^diff-from-db may report internal diffs (e.g. serial column) +cmp-ok @diffs.elems, "<=", 1, "diff-from-db: at most 1 diff after create-table"; + +# --- Test 2: describe returns correct table info --- +my $desc = PersonV1.^describe; +isa-ok $desc, Red::Cli::Table, "describe returns Red::Cli::Table"; +is $desc.name, "person_v1", "table name is snake_case"; +is $desc.columns.elems, 2, "two columns (id + name)"; + +# --- Test 3: Red::Configuration paths --- +my $config = Red::Configuration.new: :base-path($tmp-base.Str); +is $config.migration-base-path.Str, $tmp-base.add("migrations").Str, "migration base path"; +is $config.model-storage-path.Str, $tmp-base.add("migrations/models").Str, "model storage path"; +is $config.current-version, 0, "initial version is 0"; + +# --- Test 4: to-hash + JSON round-trip for Red::Cli::Table --- +# $desc already declared in Test 2 — reuse it +my $hash = $desc.to-hash; +isa-ok $hash, Hash, "to-hash returns a Hash"; +ok $hash:exists, "hash has name"; +ok $hash:exists, "hash has columns"; +is $hash.elems, 2, "hash has 2 columns"; + +# Serialize to JSON and back +use JSON::Fast; +my $json = to-json(:!pretty, $hash); +my $reloaded = from-json($json); +my $table = Red::Cli::Table.from-hash: $reloaded; +isa-ok $table, Red::Cli::Table, "from-hash reconstructs Red::Cli::Table"; +is $table.name, $desc.name, "reconstructed name matches"; +is $table.columns.elems, $desc.columns.elems, "reconstructed column count matches"; + +# --- Test 5: ensure-dirs creates directories --- +$config.ensure-dirs; +ok $config.migration-base-path.d, "migrations/ dir created"; +ok $config.model-storage-path.d, "migrations/models/ dir created"; +ok $config.version-storage-path.d, "migrations/versions/ dir created"; +ok $config.sql-storage-path.d, "migrations/sql/ dir created"; + +# --- Test 6: diff-from-db after drop + recreate --- +$*RED-DB.execute: "DROP TABLE IF EXISTS person_v1"; +PersonV1.^create-table; +@diffs = PersonV1.^diff-from-db; +cmp-ok @diffs.elems, "<=", 1, "diff-from-db after fresh create-table"; + +# --- Test 7: Configuration version-dir --- +my $vdir = $config.version-dir(1); +is $vdir.Str, $config.version-storage-path.add("1").Str, "version-dir(1) is correct"; + +# --- Test 8: sql-dir-for paths --- +my $sqldir = $config.sql-dir-for("SQLite", 1); +ok $sqldir.Str.contains("versions/1/sql/SQLite"), "sql-dir-for resolves correctly"; + +my $upfile = $config.up-sql("SQLite", 1); +ok $upfile.Str.ends-with("up.sql"), "up-sql filename is up.sql"; + +my $downfile = $config.down-sql("SQLite", 1); +ok $downfile.Str.ends-with("down.sql"), "down-sql filename is down.sql"; + +# --- Test 9: diff between two tables (old vs new) --- +model PersonV2 { + has UInt $.id is serial; + has Str $.name is column; + has UInt $.age is column; + has Str $.email is column{ :nullable }; +} + +my $old-desc = PersonV1.^describe; +my $new-desc = PersonV2.^describe; + +my @up-diffs = $old-desc.diff: $new-desc; +my $added-cols = @up-diffs.grep: { .[1] eq "+" && .[2] eq "col" }; +cmp-ok $added-cols.elems, ">=", 2, "up-diff detects at least 2 new columns"; + +my @down-diffs = $new-desc.diff: $old-desc; +my $removed-cols = @down-diffs.grep: { .[1] eq "-" && .[2] eq "col" }; +cmp-ok $removed-cols.elems, ">=", 2, "down-diff detects at least 2 removed columns"; + +# --- Test 10: diff-to-ast + translate via ^diff-from-db --- +# Create PersonV2 table so ^diff-from-db can produce real diffs +PersonV2.^create-table; +my @db-diffs = PersonV2.^diff-from-db; +# Filter out Any entries that diff-to-ast can't handle +@db-diffs = @db-diffs.grep: * ~~ Positional; +if @db-diffs { + my @asts; + for $*RED-DB.diff-to-ast(@db-diffs) -> @data { + @asts.append: @data; + } + cmp-ok @asts.elems, ">=", 1, "diff-to-ast produces at least 1 AST node"; + for @asts { + ok $_.does(Red::AST), " AST node does Red::AST role"; + } + + # --- Test 11: translate produces SQL strings --- + for @asts { + my $pair = $*RED-DB.translate($_); + ok $pair.key ne "", "translate returns non-empty SQL"; + } +} +else { + skip "no diffs from ^diff-from-db", 2; +} + +# --- Test 12: store-version creates info file --- +$config.ensure-dirs; +$config.store-version: 1, "test migration"; +my $info-file = $config.version-dir(1).add("info.txt"); +ok $info-file.f, "store-version creates info.txt"; +my $info-content = $info-file.slurp; +ok $info-content.contains("version: 1"), "info.txt contains version"; +ok $info-content.contains("test migration"), "info.txt contains description"; + +# --- Test 13: Red::Migration::Applied model works --- +use Red::Migration::Applied; +Red::Migration::Applied.^create-table; +lives-ok { Red::Migration::Applied.^create: :version(1), :name }, + "can create applied migration record"; + +my @applied = Red::Migration::Applied.^all; +cmp-ok @applied.elems, ">=", 1, "can query applied migrations"; +is @applied.map(*.version).max, 1, "max version is 1"; +ok @applied.head.applied-at.defined, "applied-at is auto-set"; + +# --- Test 14: store-model produces unique filenames --- +my $tmp-model = $tmp-base.add("TestModel2.rakumod"); +$tmp-model.spurt: 'use Red; model TestModel2 { has Int $.x is column }'; +my $stored1 = $config.store-model($tmp-model, "TestModel2"); +my $stored2 = $config.store-model($tmp-model, "TestModel2"); +isnt $stored1.basename, $stored2.basename, "produces unique filenames (merge-safe)"; +ok $stored1.basename.starts-with("TestModel2-"), "filename has model prefix"; +like $stored1.basename, / \d+ '-' + /, "filename has timestamp-random format"; + +done-testing;