use Doc::Type;
use Doc::TypeGraph::Decl;
use Doc::TypeGraph::DeclActions;

constant BASE_CLASS = "Any";

unit class Doc::TypeGraph;



head

Doc::TypeGraph - Parse a class description file, return a type graph.


# create and initialize it
my $tg = Doc::TypeGraph.new-from-file("./resources/type-graph.txt");


Doc::TypeGraph creates a graph of all types in a file. It gives you info
about what classes a type inherits from and the roles it does. In addition,
it also computes the inversion of this relations, which let you know what
types inherit a given type and the types implementing a specific role.


[ Category ]
# only one-line comments are supported
packagetype typename[role-signature]
packagetype typename[role-signature] is typename[role-signature] # inheritance
packagetype typename[role-signature] does typename[role-signature] # roles


item

[Metamodel]
# Metamodel
class Metamodel::Archetypes
role  Metamodel::AttributeContainer
class Metamodel::GenericHOW       does Metamodel::Naming
class Metamodel::MethodDispatcher is Metamodel::BaseDispatcher is Another::Something
enum  Bool                          is Int
module Test


Moritz <@moritz>
Antonio Gámiz <@antoniogamiz>


This module has been spun off from the Official Doc repo, if you want to see past changes go
to the L<official doc|https://github.com/Raku/doc>.


Copyright 2019-21 Raku Team
This library is free software; you can redistribute it and/or modify
it under the Artistic License 2.0.



#| Format: $name => Doc::Type.
has %.types;
#| Sorted array of type names.
has @.sorted;

#| Initialize %.types from a file.
method new-from-file($fn = "type-graph.txt") {
    my $filename = $fn.IO.e ?? $fn
                            !! %?RESOURCES<data/type-graph.txt>;
    my $n = self.bless;
    $n.parse-from-file($filename);
    $n;
}

#| Parse the file (using the C<Decl> grammar) and initialize C<%.types> and
#| C<@.sorted>. C<Any> will always be there, since any type (but Junctions)
#| subclass it.
method parse-from-file($fn) {
    my $f = open $fn;

    %!types{BASE_CLASS} = Doc::Type.new(:name(BASE_CLASS));

    my @categories;
    for $f.lines -> $l {
        # ignore comments
        next if $l ~~ / ^ '#' /;

        # ignore empty lines
        if $l ~~ / ^ \s* $ / {
            @categories = Empty;
            next;
        }

        # new [category]
        if $l ~~ / :s ^ '[' (\S+) + ']' $/ {
            @categories = @0>>.lc;
            next;
        }

        # parse line
        my $m = Doc::TypeGraph::Decl.parse($l, :actions(Doc::TypeGraph::DeclActions.new)).actions;

        # initialize the type
        my $type = %!types{$m.type} //= Doc::Type.new(:name($m.type));
        $type.packagetype = $m.packagetype;
        $type.categories = @categories;

        for $m.super -> $t {
            %!types{$t} //= Doc::Type.new(:name($t));
            $type.super.append: %!types{$t};
        }
        for $m.role -> $t {
            %!types{$t} //= Doc::Type.new(:name($t));
            $type.roles.append: %!types{$t};
        }

    }

    for %!types.values -> $t {
        # roles that have a superclass actually apply that superclass
        # to the class that does them, so mimic that here, including
        # parent roles
        my @roles = $t.roles;
        while @roles {
            my $r = @roles.shift;

            $t.super.append: $r.super if $r.super;
            @roles.append: $r.roles if $r.roles;
        }

        # non-roles default to superclass Any
        if $t.packagetype ne 'role' && !$t.super && $t ne 'Mu' && $t.name ne BASE_CLASS {
            $t.super.append: %!types<Any>;
        }
    }

    # this for loop initializes sub and doers attributes
    # of every Doc::Type object in %.types in order to
    # cache the inversion of all type relationships
    for %!types.values -> $t {
        $_.sub.append($t)   for $t.super;
        $_.doers.append($t) for $t.roles;
    }

    self!topo-sort;
}

#| This method takes all Doc::Type objects in %.types
#| and sort them by its name. After that, recursively,
#| add all roles and supers in the object to @!sorted
method !topo-sort {
    my %seen;
    sub visit($n) {
        return if %seen{$n};
        %seen{$n} = True;
        visit($_) for flat $n.super, $n.roles;
        @!sorted.append: $n;
    }
    visit($_) for %!types.values.sort(*.name);
}

method gist {
    @.sorted;
}


root

para

L<Examples| file:../examples/index.podlite>


L<Download |file:../download/index.podlite>


React

=begin React :component<HeaderCol> :id<menu> 
=para L<Documentation|/doc/introduction>
=para L<Modules| /mods>
=para L<Examples| file:../examples/index.podlite>
=para L<Download |file:../download/index.podlite>
=para L<About|file:../about/index.podlite>
=para 🔍 K<⌘K>/K<ctrl-K>
=end React


HEADER

FOOTER

TypeGraph

Doc::TypeGraph::Viz - Output graph in .dot format (from GraphViz)


my $tg = Doc::TypeGraph.new-from-file('test-type-graph.txt');
my $viz = Doc::TypeGraph::Viz.new;


my $path = "/tmp";
$viz.write-type-graph-images(:$path, :force, type-graph => $tg);


Class for rendering C<Doc::TypeGraph> objects in a rather rigid way;
GraphViz's C<.dot> format is used for expressing the relationships,
and they are then rendered using the C<dot> program.


Adds a new node for a type, with any attribute


Renders as a dot document with the indicated size


Saves the dot representation to an actual file


method to-file ($file, :$format = 'svg', :$size --> Promise:D)


Runs C<dot> on the file, returning a C<Promise> so that it can be used
asynchronously.


method write-type-graph-images(:$type-graph, :$path, :$force) {



unit class Doc::TypeGraph::Viz;

has @.types;
has $.dot-hints;
has $.url-base    = '/type/';
has $.rank-dir    = 'BT';
has $.role-color  = '#6666FF';
has $.enum-color  = '#33BB33';
has $.class-color = '#000000';
has $.bg-color    = '#FFFFFF';
has $.node-style  = Nil;
has $.node-soft-limit = 20;
has $.node-hard-limit = 50;

method new-for-type ($type, *%attrs) {
    my $self = self.bless(:types[$type], |%attrs);
    $self!add-neighbors;
    return $self;
}

method !add-neighbors {
    # Add all ancestors (both class and role) to @.types
    sub visit ($n) {
        state %seen;
        return if %seen{$n}++;
        visit($_) for flat $n.super, $n.roles;
        @!types.append: $n;
    }

    # Work out in all directions from @.types,
    # trying to get a decent pool of type nodes
    my @seeds = flat @.types, @.types.map(*.sub), @.types.map(*.doers);
    while (@.types < $.node-soft-limit) {
        # Remember our previous node set
        my @prev = @.types;

        # Add ancestors of all seeds to the pool nodes
        visit($_) for @seeds;
        @.types .= unique;

        # Find a new batch of seed nodes
        @seeds = (flat @seeds.map(*.sub), @seeds.map(*.doers)).unique;

        # If we're not growing the node pool, stop trying
        last if @.types <= @prev or !@seeds;

        # If the pool got way too big, drop back to previous
        # pool snapshot and stop trying
        if @.types > $.node-hard-limit {
            @.types = @prev;
            last;
        }
    }
}

method as-dot (:$size) {
    my @dot;
    @dot.append: qq:to/END/;
digraph "raku-type-graph" \{
    rankdir=$.rank-dir;
    splines=polyline;
    overlap=false;
END

    @dot.append: “    size="$size"\n” if $size;

    if $.dot-hints -> $hints {
        @dot.append: "\n    // Layout hints\n";
        @dot.append: $hints;
    }

    @dot.append: "\n    graph [truecolor=true bgcolor=\"$!bg-color\"];";
    with $!node-style {
        @dot.append: "\nnode [style=$_];";
    }

    @dot.append: "\n    // Types\n";
    for @.types -> $type {
        next unless $type;
        my $color = do given $type.packagetype {
            when ‘role’ { $.role-color  }
            when ‘enum’ { $.enum-color  }
            default     { $.class-color }
        }
        @dot.append: “    "$type.name()" [color="$color", fontcolor="$color", href="{$.url-base ~ $type.name }", fontname="FreeSans"];\n”;
    }

    @dot.append: "\n    // Superclasses\n";
    for @.types -> $type {
        next unless $type;
        for $type.super -> $super {
            @dot.append: “    "$type.name()" -> "$super" [color="$.class-color"];\n”;
        }
    }

    @dot.append: "\n    // Roles\n";
    for @.types -> $type {
        next unless $type;
        for $type.roles -> $role {
            @dot.append: “    "$type.name()" -> "$role" [color="$.role-color"];\n”;
        }
    }

    @dot.append: "\}\n";
    return @dot.join;
}

method to-dot-file ($file) {
    spurt $file, self.as-dot;
}

method to-file ($file, :$format = 'svg', :$size --> Promise:D) {
    once {
        run 'dot', '-V', :!err or die 'dot command failed! (did you install Graphviz?)';
    }
    die "bad filename '$file'" unless $file;
    my $graphvizzer = ( $file ~~ /Metamodel\:\: || X\:\:Comp/ )??'neato'!!'dot';
    my $valid-file-name = $file.subst(:g, /\:\:/,"");
    spurt $valid-file-name ~ ‘.dot’, self.as-dot(:$size).encode; # raw .dot file for debugging
    my $dot = Proc::Async.new(:w, $graphvizzer, '-T', $format, '-o', $valid-file-name);
    my $promise = $dot.start;
    await($dot.write(self.as-dot(:$size).encode));
    $dot.close-stdin;
    $promise
}


method write-type-graph-images(:$type-graph, :$path, :$force) {

    for $type-graph.sorted -> $type {
        FIRST my @type-graph-images;

        my $this-path = "{$path}/type-graph-$type.svg";

        my $dest = $this-path.IO;
        if $dest.e and ! $force {
           say qq:to/EOT/;
Not writing image for $this-path, it seems to be up-to-date
To force writing of type graph images, supply the --force option at the
command line, or delete file 'html/images/type-graph-$type.svg'";
EOT
            next;
        }

        my $viz = Doc::TypeGraph::Viz.new-for-type($type,
                :$!class-color, :$!enum-color, :$!role-color, :$!bg-color, :$!node-style);
        @type-graph-images.push: $viz.to-file($this-path, format => 'svg');

        LAST await @type-graph-images;
    }

    my %by-group = $type-graph.sorted.classify(&viz-group);
    %by-group<Exception>.append: $type-graph.types< Exception Any Mu >;
    %by-group<Metamodel>.append: $type-graph.types< Any Mu >;

    for %by-group.kv -> $group, @types {
        FIRST my @specialized-visualizations;

        my $viz = Doc::TypeGraph::Viz.new(:@types,
                :dot-hints(viz-hints($group)),
                :rank-dir('LR'),
                :$!class-color, :$!enum-color, :$!role-color, :$!bg-color, :$!node-style);
        @specialized-visualizations.push: $viz.to-file("$path/type-graph-{$group}.svg", format => 'svg');

        LAST await @specialized-visualizations;
    }
}

sub viz-group($type) {
    return 'Metamodel' if $type.name ~~ /^ 'Perl6::Metamodel' /;
    return 'Exception' if $type.name ~~ /^ 'X::' /;
    return 'Any';
}

sub viz-hints($group) {
    return '' unless $group eq 'Any';

    return '
    subgraph "cluster: Mu children" {
        rank=same;
        style=invis;
        "Any";
        "Junction";
    }
    subgraph "cluster: Pod:: top level" {
        rank=same;
        style=invis;
        "Pod::Config";
        "Pod::Block";
    }
    subgraph "cluster: Date/time handling" {
        rank=same;
        style=invis;
        "Date";
        "DateTime";
        "DateTime-local-timezone";
    }
    subgraph "cluster: Collection roles" {
        rank=same;
        style=invis;
        "Positional";
        "Associative";
        "Baggy";
    }
';
}

# vim: expandtab shiftwidth=4 ft=perl6


Doc::Type - Used to represent different types in a typegraph


# create and name it
my $type = Doc::Type.new(:name("Rat"));


# add some properties
$type.super.push(["Any", "Mu", "Numeric"]);
$type.roles.push(["Role1", "Role2"]);


C<Doc::Type> represents a type in the Raku language. It stores
its parent classes and the role it's implementing. In addition, it also
stores the inverted relation, that's to say: all types inheriting from
this one, and if it's a role, all types implementing it.


Moritz Lenz <@moritz>
Antonio Gámiz <@antoniogamiz>


This module has been spun off from the L<official Raku
documentation repository|https://github.com/Raku/doc>, check it out for past
history of this code..


Copyright 2019 Moritz and Antonio Gámiz.
This library is free software; you can redistribute it and/or modify
it under the Artistic License 2.0.



#| Name of the type.
has Str $.name handles <Str>;
#| All the classes of the type.
has @.super;
#| All classes inheriting from this type.
has @.sub;
#| All roles implemented by the type.
has @.roles;
#| If it's a role, all types implementing it.
has @.doers;
#| One of C<class>, C<role>, C<module> or C<enum>.
has $.packagetype is rw = 'class';
#| One of C<Metamodel>, C<Domain-specific>, C<Basic>, C<Composite>, C<Exceptions> or C<Core>.
has @.categories;
#| Method Resolution Order (MRO) of the type.
has @.mro;

#| Computes the MRO and stores it in @.mro.
method mro(Doc::Type:D:) {
    # do not recompute mro
    return @!mro if @!mro;
    # say "=";
    if @.super == 1 {
        if ($.name eq any(<Any>) and @.super[0].name eq "Any") {return []}
        @!mro = @.super[0].mro;
    } elsif @.super > 1 {
        if ($.name eq any(<Any>) and @.super[0].name eq "Any") {return []}
        my @merge_list = @.super.map: *.mro.item;
        @!mro = self.c3_merge(@merge_list);
    }

    @!mro.unshift: self;
    @!mro;
}

#| C3 linearization algorithm (L<more info|https://en.wikipedia.org/wiki/C3_linearization>).
method c3_merge(@merge_list) {
    my @result;
    my $accepted;
    my $something_accepted = 0;
    my $cand_count = 0;

    # find a candidate
    for @merge_list -> @cand_list {
        next unless @cand_list;
        my $rejected = 0;
        my $cand_class = @cand_list[0];
        $cand_count++;
        # search cyclic inheritance. If it's found then reject the candidate
        for @merge_list {
            say "List $_";
            next if $_ === @cand_list;
            for 1..+$_ -> $cur_pos {
                if $_[$cur_pos] === $cand_class {
                    say "$cur_pos, $cand_class";
                    $rejected = 1;
                    last;
                }
            }
        }
        # continue until some candidate is found
        unless $rejected {
            $accepted = $cand_class;
            $something_accepted = 1;
            last;
        }
    }

    # this means @merge_list was initially empty
    return () unless $cand_count;

    # no candidate was found
    unless $something_accepted {
        die("Could not build C3 linearization for {self}: ambiguous hierarchy");
    }

    # deletes accepted candidate from all elements in the list
    for @merge_list.keys -> $i {
        @merge_list[$i] = [@merge_list[$i].grep: { $_ ne $accepted }] ;
    }

    # repeat
    @result = self.c3_merge(@merge_list);
    @result.unshift: $accepted;
    @result;
}

method gist {
    my $supers     = @.super.map({.name}) || "None";
    my $sub        = @.sub.map({.name}) || "None";
    my $roles      = @.roles.map({.name}) || "None";
    my $doers      = @.doers.map({.name}) || "None";
    my $categories = @.categories || "None";
    my $mro        = @.mro.map({.name}) || "None";

    return "\{"                     ~
        "supers: $supers, "         ~
        "sub: $sub, "               ~
        "roles: $roles, "           ~
        "doers: $doers, "           ~
        "categories: $categories, " ~
        "mro: $mro"                 ~
        "\}"
}

# vim: expandtab shiftwidth=4 ft

Type

The Raku Knowledge Base


=begin React :component<HeaderCol> :id<footer>  
=begin nested :!nested
=item1 B<Language>
    =item2 L<Get started|file:../getting-started/getting-started.podlite>
    =item2 L<Why Raku?|/doc/language/faq#Why-should-I-learn-Raku-What's-so-great-about-it>
    =item2 L<Try Raku|https://glot.io/new/raku>
    =item2 L<Raku cheat sheet|https://github.com/Raku/mu/blob/master/docs/Perl6/Cheatsheet/cheatsheet.txt>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<Raku on Exercism|https://exercism.org/tracks/raku>
    =item2 L<Wikipedia|https://en.wikipedia.org/wiki/Raku_(programming_language)>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=begin nested :!nested

=item1 B<L<Documentation|/doc>>
    =item2 L<Getting started, Migration guides from other languages, & Tutorials | file:../doc/introduction.podlite>
    =item2 L<Language References|file:../doc/reference.podlite>
    =item2 L<Type Reference| file:../doc/types.podlite>
    =item2 L<Miscellaneous| file:../doc/miscellaneous.podlite>
    =item2 L<FAQs (Frequently Asked Questions)|/doc/language/faq>
    =item2 L<Community|/doc/language/community>
    =item2 L<The list of all documents|file:../doc/index.podlite>

=item1 B<Resources>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>

=end nested
=begin nested :!nested

=item1 B<Resoures>
    =item2 L<Download | file:../download/index.podlite>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=item1 B<Learning>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Wikibook |https://en.wikibooks.org/wiki/Raku_Programming>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>
    =item2 L<Learn Raku in Y minutes|https://learnxinyminutes.com/docs/raku/>
    =item2 L<Golfing |https://github.com/AlexDaniel/raku-golf-cheatsheet>
=end nested
=begin nested :!nested

=item1 B<Explore>
    =item2 L<Raku Blog Aggregator|https://planet.raku.org/>
    =item2 L<Rakudo Weekly|https://rakudoweekly.blog/>
    =item2 L<The Weekly Challenge |https://perlweeklychallenge.org/>
    =item2 L<Raku Advent Calendar|https://raku-advent.blog/>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=end React


=begin React :component<CookieConsent> :id<CookieConsent> :buttonCaption("Got it!")
=para
This website uses cookies for analytics.
=end React


TypeGraph

NAME

SYNOPSIS

DESCRIPTION

FILE SYNTAX

AUTHOR

COPYRIGHT AND LICENSE

Doc::TypeGraph v2.2.1.1

Authors

License

Dependencies

Test Dependencies

Provides

Documentation