RaCoCo result: Red

# Red 66%

    use v6;
    use Red::Do;
    use Red::Model;
    use Red::Attr::Column;
    use Red::Column;
    use Red::ColumnMethods;
    use Red::Utils;
    use Red::ResultSeq;
    use Red::DefaultResultSeq;
    use Red::Attr::Query;
    use Red::AST;
    use MetamodelX::Red::Model;
    use Red::Traits;
    use Red::Operators;
    use Red::Database;
    use Red::AST::Optimizer::AND;
    use Red::AST::Optimizer::OR;
    use Red::AST::Optimizer::Case;
    use Red::Class;
    use Red::DB;
    use Red::Schema;
    use Red::Formatter;
    use Red::AST::Infixes;

    class Red:ver<0.1.54>:api<2> {
        our %experimentals;
        our @experimental-roles;
        method events   { Red::Class.instance.events }
        method emit(|c) { get-RED-DB.emit: |c        }
        method experimentals { %experimentals }
        method ping {
            do for (%GLOBAL::RED-DEFULT-DRIVERS || :default(get-RED-DB)).kv -> $key, $conn {
                $key => $conn.ping
            }.Map
        }
        method exports(@experimentals --> Map()) {
            %Red::experimentals{$_} = True for @experimentals;
            Red::Do::EXPORT::ALL::,
            Red::Traits::EXPORT::ALL::,
            Red::Operators::EXPORT::ALL::,
            Red::Schema::EXPORT::ALL::,
            ‘&database’ => &database,
            |@experimentals.map(-> $feature { |experimental( $feature ) })
        }
    }

    BEGIN {
        Red::Column.^add_role: Red::ColumnMethods;
        Red::Column.^compose;

        for <AND OR Case> -> $infix {
            ::("Red::AST::$infix").^add_role: ::("Red::AST::Optimizer::$infix");
            ::("Red::AST::$infix").^compose;
        }
    }

    my package EXPORTHOW {
        package DECLARE {
            constant model = MetamodelX::Red::Model;
        }
    }

    proto experimental(Str) {*}

    multi experimental("shortname") {
        MetamodelX::Red::Model.^add_method: "experimental-name", method (\model) { model.^shortname }
        MetamodelX::Red::Model.^compose;
        Empty
    }

    multi experimental("formatters") {
        MetamodelX::Red::Model.^add_method: "experimental-formatter", method { True }
        Red::Column.^add_method: "experimental-formatter", method { True }
        MetamodelX::Red::Model.^compose;
        Red::Column.^compose;
        Empty
    }

    multi experimental($ where "experimental migrations" | "migrations") {
        require ::('MetamodelX::Red::Migration');
        @Red::experimental-roles.push: ::('MetamodelX::Red::Migration');

        Empty
    }

    multi experimental("supply") {
        require ::('MetamodelX::Red::Supply');
        @Red::experimental-roles.push: ::('MetamodelX::Red::Supply');

        Empty
    }

    multi experimental("is-handling") {
        multi trait_mod:<is>(Mu:U $model, :$handling) {
            for $handling<> {
                my ($orig, $new) = $_ ~~ Pair ?? [.key, .value] !! [$_, $_];
                $model.^add_method: $new, method (|c) { self.^all."$orig"(|c) }
            }
        }
        Map(
                '&trait_mod:<is>' => &trait_mod:<is>
        )
    }

    multi experimental("has-one") {
        Empty
    }

    multi experimental("refreshable") {
        require ::('MetamodelX::Red::Refreshable');
        @Red::experimental-roles.push: ::('MetamodelX::Red::Refreshable');

        Empty
    }

    multi experimental($feature) { die "Experimental feature '{ $feature }' not recognized." }

    multi EXPORT(+@experimentals) {
    	#my $no = "no-optimization";
        	#if @experimentals.none eq $no {
    	#        require ::("Red::AST::Infixes");
        	#        for <AND OR Case> -> $infix {
    	#		::("Red::AST::$infix").^add_role: ::("Red::AST::Optimizer::$infix");
    	#		::("Red::AST::$infix").^compose;
        	#        }
        	#} else {
        	#        @experimentals .= grep: { $_ ne $no }
        	#}
        Red.exports(@experimentals)
    }

    =begin pod

    [![Build Status](https://github.com/FCO/Red/workflows/test/badge.svg)](https://github.com/FCO/Red/actions)

    [![Build Status](https://github.com/FCO/Red/workflows/ecosystem/badge.svg)](https://github.com/FCO/Red/actions)

    =begin head1
    Red
    =end head1

    Take a look at our Documentation: L<https://fco.github.io/Red/>

    =head2 Red - A **WiP** ORM for Raku

    =head2 INSTALL

    Install with (you need **rakudo 2018.12-94-g495ac7c00** or **newer**):

        zef install Red

    =head2 SYNOPSIS

    =begin code :lang<perl6>

    use Red:api<2>;

    model Person {...}

    model Post is rw {
        has Int         $.id        is serial;
        has Int         $!author-id is referencing( *.id, :model(Person) );
        has Str         $.title     is column{ :unique };
        has Str         $.body      is column;
        has Person      $.author    is relationship{ .author-id };
        has Bool        $.deleted   is column = False;
        has DateTime    $.created   is column .= now;
        has Set         $.tags      is column{
            :type<string>,
            :deflate{ .keys.join: "," },
            :inflate{ set(.split: ",") }
        } = set();
        method delete { $!deleted = True; self.^save }
    }

    model Person is rw {
        has Int  $.id            is serial;
        has Str  $.name          is column;
        has Post @.posts         is relationship{ .author-id };
        method active-posts { @!posts.grep: not *.deleted }
    }

    my $*RED-DB = database "SQLite";

    Person.^create-table;
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    CREATE TABLE person(
        id integer NOT NULL primary key
        AUTOINCREMENT,
        name varchar(255) NOT NULL
    )
    =end code

    =begin code :lang<perl6>
    Post.^create-table;
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    CREATE TABLE post(
        id integer NOT NULL primary key AUTOINCREMENT,
        author_id integer NULL references person(id),
        title varchar(255) NOT NULL,
        body varchar(255) NOT NULL,
        deleted integer NOT NULL,
        created varchar(32) NOT NULL,
        tags varchar(255) NOT NULL,
        UNIQUE (title)
    )
    =end code

    =begin code :lang<perl6>
    my Post $post1 = Post.^load: :42id;
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    SELECT
        post.id,
        post.author_id as "author-id",
        post.title,
        post.body,
        post.deleted,
        post.created,
        post.tags
    FROM
        post
    WHERE
        post.id = 42
    =end code

    =begin code :lang<perl6>
    my Post $post1 = Post.^load: 42;
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    SELECT
        post.id,
        post.author_id as "author-id",
        post.title,
        post.body,
        post.deleted,
        post.created,
        post.tags
    FROM
        post
    WHERE
        post.id = 42
    =end code

    =begin code :lang<perl6>
    my Post $post1 = Post.^load: :title("my title");
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    SELECT
        post.id,
        post.author_id as "author-id",
        post.title,
        post.body,
        post.deleted,
        post.created,
        post.tags
    FROM
        post
    WHERE
        post.title = ‘my title’
    =end code

    =begin code :lang<perl6>
    my $person = Person.^create: :name<Fernando>;
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    INSERT INTO person(
        name
    )
    VALUES(
        ?
    )
    -- BIND: ["Fernando"]

    -- SQLite needs an extra select:

    SELECT
        person.id,
        person.name
    FROM
        person
    WHERE
        _rowid_ = last_insert_rowid()
    LIMIT 1
    =end code

    =begin code :lang<perl6>
    RETURNS:
    Person.new(name => "Fernando")
    =end code

    =begin code :lang<perl6>
    # Using Pg Driver for this block
    {
        my $*RED-DB = database "Pg";
        my $person = Person.^create: :name<Fernando>;
    }
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    INSERT INTO person(
        name
    )
    VALUES(
        $1
    ) RETURNING *
    -- BIND: ["Fernando"]
    =end code

    =begin code :lang<perl6>
    RETURNS:
    Person.new(name => "Fernando")
    =end code

    =begin code :lang<perl6>
    say $person.posts;
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    SELECT
        post.id,
        post.author_id as "author-id",
        post.title,
        post.body,
        post.deleted,
        post.created,
        post.tags
    FROM
        post
    WHERE
        post.author_id = ?
    -- BIND: [1]
    =end code

    =begin code :lang<perl6>
    say Person.new(:2id)
        .active-posts
        .grep: { .created > now }
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    SELECT
        post.id,
        post.author_id as "author-id",
        post.title,
        post.body,
        post.deleted,
        post.created,
        post.tags
    FROM
        post
    WHERE
        (
           post.author_id = ?
           AND (
               post.deleted == 0
               OR post.deleted IS NULL
           )
        )
        AND post.created > 1554246698.448671
    -- BIND: [2]
    =end code

    =begin code :lang<perl6>
    my $now = now;
    say Person.new(:3id)
        .active-posts
        .grep: { .created > $now }
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    SELECT
        post.id,
        post.author_id as "author-id",
        post.title,
        post.body,
        post.deleted,
        post.created,
        post.tags
    FROM
        post
    WHERE
        (
           post.author_id = ?
           AND (
               post.deleted == 0
               OR post.deleted IS NULL
           )
        )
        AND post.created > ?
    -- BIND: [
    --   3,
    --   Instant.from-posix(
    --       <399441421363/257>,
    --       Bool::False
    --   )
    -- ]
    =end code

    =begin code :lang<perl6>
    Person.^create:
        :name<Fernando>,
        :posts[
            {
                :title("My new post"),
                :body("A long post")
            },
        ]
    ;
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    INSERT INTO person(
        name
    )
    VALUES(
        ?
    )
    -- BIND: ["Fernando"]

    SELECT
        person.id,
        person.name
    FROM
        person
    WHERE
        _rowid_ = last_insert_rowid()
    LIMIT 1
    -- BIND: []

    INSERT INTO post(
        created,
        title,
        author_id,
        tags,
        deleted,
        body
    )
    VALUES(
        ?,
        ?,
        ?,
        ?,
        ?,
        ?
    )
    -- BIND: [
    --   "2019-04-02T22:55:13.658596+01:00",
    --   "My new post",
    --   1,
    --   "",
    --   Bool::False,
    --   "A long post"
    -- ]

    SELECT
        post.id,
        post.author_id as "author-id",
        post.title,
        post.body,
        post.deleted,
        post.created,
        post.tags
    FROM
        post
    WHERE
        _rowid_ = last_insert_rowid()
    LIMIT 1
    =end code

    =begin code :lang<perl6>
    my $post = Post.^load: :title("My new post");
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    SELECT
        post.id,
        post.author_id as "author-id",
        post.title,
        post.body,
        post.deleted,
        post.created,
        post.tags
    FROM
        post
    WHERE
        post.title = ‘My new post’
    -- BIND: []
    =end code

    =begin code :lang<perl6>
    RETURNS:
    Post.new(
       title   => "My new post",
       body    => "A long post",
       deleted => 0,
       created => DateTime.new(
           2019,
           4,
           2,
           23,
           7,
           46.677388,
           :timezone(3600)
       ),
       tags    => Set.new("")
    )
    =end code

    =begin code :lang<perl6>
    say $post.body;
    =end code

    =begin code :lang<perl6>
    PRINTS:
    A long post
    =end code

    =begin code :lang<perl6>
    my $author = $post.author;
    =end code

    =begin code :lang<perl6>
    RETURNS:
    Person.new(name => "Fernando")
    =end code

    =begin code :lang<perl6>
    $author.name = "John Doe";

    $author.^save;
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    UPDATE person SET
        name = ‘John Doe’
    WHERE id = 1
    =end code

    =begin code :lang<perl6>
    $author.posts.create:
        :title("Second post"),
        :body("Another long post");
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    INSERT INTO post(
        title,
        body,
        created,
        tags,
        deleted,
        author_id
    )
    VALUES(
        ?,
        ?,
        ?,
        ?,
        ?,
        ?
    )
    -- BIND: [
    --   "Second post",
    --   "Another long post",
    --   "2019-04-02T23:28:09.346442+01:00",
    --   "",
    --   Bool::False,
    --   1
    -- ]
    =end code

    =begin code :lang<perl6>
    $author.posts.elems;
    =end code

    =begin code :lang<sql>
    -- Equivalent to the following query:
    SELECT
        count(*) as "data_1"
    FROM
        post
    WHERE
        post.author_id = ?
    -- BIND: [1]
    =end code

    =begin code :lang<perl6>
    RETURNS:
    2
    =end code

    =head2 DESCRIPTION

    Red is a *WiP* ORM for Raku.

    =head3 traits

    =item C<is column>
    =item C<is column{}>
    =item C<is id>
    =item C<is id{}>
    =item C<is serial>
    =item C<is referencing{}>
    =item C<is relationship{}>
    =item C<is table<>>
    =item C<is nullable>

    =head3 features:

    =head4 relationships

    Red will infer relationship data if you use type constraints on your properties.

    =begin code :lang<perl6>
    # Single file e.g. Schema.pm6

    model Related { ... }

    # belongs to
    model MyModel {
        has Int     $!related-id is referencing( *.id, :model<Related> );
        has Related $.related    is relationship{ .id };
    }

    # has one/has many
    model Related {
        has Int $.id is serial;
        has MyModel @.my-models is relationship{ .related-id };
    }
    =end code

    If you want to put your schema into multiple files, you can create an "indirect"
    relationship, and Red will look up the related models as necessary.

    =begin code :lang<perl6>
    # MyModel.pm6
    model MyModel {
        has Int     $!related-id is referencing{ :model<Related>, :column<id> };
        has         $.related    is relationship({ .id }, :model<Related>);
    }

    # Related.pm6
    model Related {
        has Int $.id is serial;
        has     @.my-models is relationship({ .related-id }, :model<MyModel>);
    }
    =end code

    If Red can’t find where your C<model> is defined you can override where it looks
    with C<require>:

    =begin code :lang<perl6>
        has Int     $!related-id is referencing{ :model<Related>, :column<id>,
                                                 :require<MyApp::Schema::Related> };
    =end code

    =head4 custom table name

    =begin code :lang<perl6>

    model MyModel is table<custom_table_name> {}

    =end code

    =head4 not nullable columns by default

    Red, by default, has not nullable columns, to change it:

    =begin code :lang<perl6>
    #| This makes this model’s columns nullable by default
    model MyModel is nullable {
        has Int $.col1 is column;               #= this column is nullable
        has Int $.col2 is column{ :!nullable }; #= this one is not nullable
    }
    =end code

    =head4 load object from database

    =begin code :lang<perl6>
    MyModel.^load: 42;
    MyModel.^load: id => 42;
    =end code

    =head4 save object on the database

    =begin code :lang<perl6>
    $object.^save;
    =end code

    =head4 search for a list of object

    =begin code :lang<perl6>
    Question.^all.grep: { .answer == 42 }; # returns a result seq
    =end code

    =head4 phasers

    =item C<before-create>
    =item C<after-create>
    =item C<before-update>
    =item C<after-update>
    =item C<before-delete>
    =item C<after-delete>

    =head4 Temporary table

    =begin code :lang<perl6>
    model Bla is temp { ... }
    =end code

    =head4 Create table

    =begin code :lang<perl6>
    Question.^create-table;
    Question.^create-table: :if-not-exists;
    Question.^create-table: :unless-exists;
    =end code

    =head4 IN

    =begin code :lang<perl6>
    Question.^all.grep: *.answer ⊂ (3.14, 13, 42)
    =end code

    =head4 create

    =begin code :lang<perl6>

    Post.^create: :body("bla ble bli blo blu"), :title("qwer");

    model Tree {
        has UInt   $!id        is id;
        has Str    $.value     is column;
        has UInt   $!parent-id is referencing{ Tree.id };

        has Tree   $.parent    is relationship{ .parent-id };
        has Tree   @.kids      is relationship{ .parent-id };
    }

    Tree.^create-table: :if-not-exists;

    Tree.^create:
        :value<Bla>,
        :parent{:value<Ble>},
        :kids[
            {:value<Bli>},
            {:value<Blo>},
            {:value<Blu>}
        ]
    ;

    =end code

    =head2 AUTHOR

    Fernando Correa de Oliveira <fernandocorrea@gmail.com>

    =head2 COPYRIGHT AND LICENSE

    Copyright 2018 Fernando Correa de Oliveira

    This library is free software; you can redistribute it and/or modify it under the Artistic License 2.0.

    =end pod