Custom Column type classes

[jonathanstowe]

I was thinking of allowing for types on columns which consumed a role something like Red::Role::ColumnType that allows the type to provide its own deflate and inflate methods that could be used instead of inline inflators and deflators. So you can have something like

class Password is Str does Red::Role::ColumnType {
   method inflate($value) {
       # Hash password
   }
   method deflate( $value  ) {
      # Probably just return the value as we can't dehash
   }

   method check-password($value) {
       # do the hash and compare thing.
   }
}

model  User {
      has Password $.password is column  handles <check-password>;
      ...
}

I just wanted to get this in before I forgot about it again so it could use some more details.

[FCO]

@jonathanstowe doing that, do you think we should inflate the terms we search also? I mean: User.^all.grep: *.password eq "bla" should generate a SQL with WHERE password = 'bla' or WHERE password = '128ecf542a35ac5270a87dc740918404'?

[FCO]

if it should be inflated, should be a way to say that I don't want it to be inflated?

[FCO]

should inflators/deflators receive the whole object as argument? If, for example, the Password type uses the username and a salt column as salt to hash.

[jonathanstowe]

Or maybe the type could provide a mechanism to do certain operators so in the 'eq' case it would have a:

    multi method equals($lhs, Str $rhs --> Bool ) {
        # usual hash the $rhs using the $lhs as the salt and compare
    }

But unless you can express the operation as SQL that would require reverting to a standard grep and not using SQL.

Though I'd be inclined to favour using a specific method to handle this particular thing.

The password thing might be a bit of a distraction though, as the use cases get a little specific. one typically wouldn't, for instance, search by password but compare the password of a single row (which is is why there is a handles in the example.

Typically you would want to deflate the RHS of an operator for comparison to the raw value of the column, but this doesn't necessarily work for, say, a salted hash password as you may not know everything you need to know (i.e. the salt,) before retrieving an individual column.

I think it would be helpful if I made a more neutral PoC for this so we can work out the basic features.

[FCO]

Maybe something like multi infix:<eq>(Red::AST $a where *.returns ~~ Password, $)

_{Sent with GitHawk}

[FCO]

https://modules.raku.org/dist/RedX::HashedPassword:cpan:JSTOWE

[jonathanstowe]

Yep that shaved that particular yak as after a period of thinking about the password case I began to realise that is just wanted to be a string with special properties and which had a custom deflater/inflater so everything could be done from where we were.

But I think the more general case stands e,g,:

class Point {
    has Int $.x;
    has Int $.y;

    method do-something-with-point() {
    ....
    }
}

class DbPoint is Point does Red::Type {
    has Str $.column-type = 'text';

    method inflate-point(Str $point-str --> Point ) is red-inflate {
        my ( $x, $y ) =  $point-str.split(/,/);
        $?CLASS.new(:$x, :$y);
    }

    method deflate-point( --> Str ) is red-deflate  {
        "{$!x},{$!y}";
     }
}

model Place {
     has Int $.id               is serial;     
     has DbPoint $.point is column handles <do-something-with-point>
     ....
}

So in all the places that it needs to know the column-type, or does inflate or deflate it uses the information and methods from the type class.

[FCO]

Would something like this make sense? lib/Red/Type/Json.pm6

[FCO]

I’m thinking of creating the Red::Type as you suggested and convert this JSON to use that. But more than inflate and deflate the new types, I’m thinking on how to make it have new methods while querying (as the .AT-KEY from json (lib/Red/ColumnMethods.pm6) and specializing it).

[FCO]

A Vector Red::Type could, for example, have a module method that on queries would be translated to sqrt(pow(x, 2) + pow(y, 2)) and would make it possible to: Force.^all.grep: *.vector.module > 10

[jonathanstowe]

Of course in the JSON case Pg will let you do queries on the content of the document, so you'd want to use the native capabilities of the DB wherever possible. But yeah that kind of thing.

[FCO]

Yes, the json already does that... the driver translates the AST the right way

[FCO]

Let's create Red::Type!

[jonathanstowe]

Yeah I'll take a look at that if I get a minute (juggling a few ideas at the moment,)

[FCO]

:) thanks! I won’t have time today, but I’ll take a look at it this next weekend

[FCO]

I've been trying to implement this this weekend and the way I think it should work started shifting.

I've been using the Vector type as example, the way I was thinking it would have a inflate (that would read receive the value stored on the column (the type of the column would be decided by the type passed to the Red::Type[$type] role) and return a Vector object), deflate (that would return a 1 column representation of that Vector "(x,y)") and module method that should be generic to calculate the module into the object and if it's not defined, make it on DB as SQL.

But now I think Red::Type should be able to create new columns into the model where it's used, so for example:

model VectorList {
   has Uint $.id is serial;
   has Vector $.vec is column; # or a different trait, `is stored`, `is on-db` or `is red-type`
}

########

class Vector is Red::Type {
   has Rat $.x is column;
   has Rat $.y is column;

   method module {
      ($.x ** 2 + $.y ** 2) ** (½)
   }
}

the vector_list table should have 3 columns: id, vec_x and vec_y. I don't know how to do from Vector type object, access VectorList data (it would be needed at least to get the table name from that). Maybe Red::Type should be a role, and do it as:

has Vector[VectorList] $.vec is column;

But w would need to "override" it with the object when it's defined.

Any thoughts about it? @jonathanstowe ?

[FCO]

Maybe the trait on $.vec could create a specialization of Vector the know what class it's being used with...

has Vector $.vec is red-type;

would create a Vector but role :: { method used-on { VectorList } }. Even better if we do that on the meta class.

[FCO]

Maybe that would make more sense to be a Role, and bring Red::Type back to the original idea... I mean:

model VectorList does Vector {
   has Uint $.id is serial;
}

########

role Vector {
   has Rat $.x is column;
   has Rat $.y is column;

   method module {
      ($.x ** 2 + $.y ** 2) ** (½)
   }
}

[FCO]

➜  Red git:(master) ✗ raku -I. -MRed -MRed::Type -e '
class Point {
   has $.x;
   has $.y;
}

class DBPoint does Red::Type {
   method inflator { -> Str $p --> Point { my ($x, $y) = $p.split: ","; Point.new: :$x, :$y } }
   method deflator { -> Point $_ --> Str { "{.x},{.y}" } }
   method red-type-column-type    { "varchar(10)" }
   method red-type-accepts(Point) { True }
}

model Place {
   has UInt    $.id    is serial;
   has DBPoint $.point is column;
}

my $*RED-DB = database "Pg";
my $*RED-DEBUG = True;
schema(Place).drop.create;

Place.^create: :point(Point.new: :0x, :10y);
.point.say for Place.^all;

'
SQL : DROP TABLE IF EXISTS "place" CASCADE
BIND: []
SQL : CREATE TABLE "place" (
   id serial NOT NULL primary key,
   point varchar(10) NOT NULL
)
BIND: []
SQL : INSERT INTO "place"(
   point
)
VALUES(
   $1
) RETURNING *
BIND: ["0,10"]
SQL : SELECT
   "place".id , "place".point
FROM
   "place"
BIND: []
Point.new(x => "0", y => "10")

[FCO]

Now I'm working to make something like this work everywhere:

➜  Red git:(master) ✗ raku -I. -MRed -MRed::Type -MRed::AST::Value -MRed::AST::JsonItem -MRed::AST::Unary -e '
class Point {
   has $.x;
   has $.y;
}

class DBPoint does Red::Type {
   method inflator { -> $_ { Point.new: |.<> } }
   method deflator { -> $_ { %( :x(.x), :y(.y) ) } }
   method red-type-column-type    { "jsonb" }
   method red-type-accepts(Point) { True }
   method red-type-db-methods {
      role :: {
         method x {
            Red::AST::Cast.new: Red::AST::JsonItem.new(self, ast-value "x"), "integer"
         }
      }
   }
}
model Place {
   has UInt    $.id    is serial;
   has DBPoint $.point is column;
}

my $*RED-DB = database "Pg";
my $*RED-DEBUG = True;
schema(Place).drop.create;

Place.^create: :point(Point.new: :0x, :10y);
.point.say for Place.^all.grep: *.point.x >= 0;

'
SQL : DROP TABLE IF EXISTS "place" CASCADE
BIND: []
SQL : CREATE TABLE "place" (
   id serial NOT NULL primary key,
   point jsonb NOT NULL
)
BIND: []
SQL : INSERT INTO "place"(
   point
)
VALUES(
   $1
) RETURNING *
BIND: [{:x(0), :y(10)},]
SQL : SELECT
   "place".id , "place".point
FROM
   "place"
WHERE
   ("place".point -> 'x')::integer >= 0
BIND: []
Point.new(x => 0, y => 10)

[FCO]

For Pg it seems to be working... I still need to fix it on SQLite: (on branch add-methods-from-red-type)

➜  Red git:(add-methods-from-red-type) ✗ RED_DATABASE=Pg RED_DEBUG=1 raku -I. t/75-red-type.t
SQL : DROP TABLE IF EXISTS "place" CASCADE
BIND: []
SQL : CREATE TABLE "place" (
   id serial NOT NULL primary key,
   point jsonb NOT NULL
)
BIND: []
SQL : INSERT INTO "place"(
   point
)
VALUES(
   $1
) RETURNING *
BIND: [{:x(0), :y(10)},]
SQL : SELECT
   "place".id , "place".point
FROM
   "place"
LIMIT 1
BIND: []
ok 1 - The object is-a 'Place'
ok 2 - The object is-a 'Point'
ok 3 -
ok 4 -
SQL : SELECT
   "place".id , "place".point
FROM
   "place"
WHERE
   ("place".point -> 'x')::integer >= 0
BIND: []
Place.new(id => 1, point => Point.new(x => 0, y => 10))
1..4
➜  Red git:(add-methods-from-red-type) ✗ RED_DATABASE=SQLite RED_DEBUG=1 raku -I. t/75-red-type.t
SQL : DROP TABLE IF EXISTS "place"
BIND: []
SQL : BEGIN
BIND: []
SQL : CREATE TABLE "place" (
   id integer NOT NULL primary key AUTOINCREMENT,
   point jsonb NOT NULL
)
BIND: []
SQL : COMMIT
BIND: []
SQL : BEGIN
BIND: []
SQL : INSERT INTO "place"(
   point
)
VALUES(
   ?
)
BIND: [{:x(0), :y(10)},]
SQL : ROLLBACK
BIND: []
Died with X::Red::Driver::Mapped::UnknownError
  in method execute at /Users/fernandooliveira/.rakubrew/versions/moar-2022.04/share/perl6/site/sources/A116A1D38801BD23424D3F56A4DD149282A124BE (DBDish::SQLite::StatementHandle) line 39
  in method stt-exec at /Users/fernandooliveira/Red/lib/Red/Driver/SQLite.pm6 (Red::Driver::SQLite) line 41
  in method execute at /Users/fernandooliveira/Red/lib/Red/Driver.pm6 (Red::Driver) line 117
  in method save at /Users/fernandooliveira/Red/lib/MetamodelX/Red/Model.pm6 (MetamodelX::Red::Model) line 461
  in method create at /Users/fernandooliveira/Red/lib/MetamodelX/Red/Model.pm6 (MetamodelX::Red::Model) line 562
  in block <unit> at t/75-red-type.t line 45

Actually thrown at:
  in block  at /Users/fernandooliveira/Red/lib/Red/Statement.pm6 (Red::Statement) line 18
  in any  at /Users/fernandooliveira/Red/lib/Red/Statement.pm6 (Red::Statement) line 16
  in method execute at /Users/fernandooliveira/.rakubrew/versions/moar-2022.04/share/perl6/site/sources/A116A1D38801BD23424D3F56A4DD149282A124BE (DBDish::SQLite::StatementHandle) line 39
  in method stt-exec at /Users/fernandooliveira/Red/lib/Red/Driver/SQLite.pm6 (Red::Driver::SQLite) line 41
  in method execute at /Users/fernandooliveira/Red/lib/Red/Driver.pm6 (Red::Driver) line 117
  in method save at /Users/fernandooliveira/Red/lib/MetamodelX/Red/Model.pm6 (MetamodelX::Red::Model) line 461
  in method create at /Users/fernandooliveira/Red/lib/MetamodelX/Red/Model.pm6 (MetamodelX::Red::Model) line 562
  in block <unit> at t/75-red-type.t line 45

[FCO]

https://github.com/FCO/Red/pull/564

[FCO]

@jonathanstowe what do you think about that?