<commit_before>! Copyright (C) 2007, 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes classes.builtin
classes.intersection classes.mixin classes.predicate
classes.singleton classes.tuple classes.union combinators
definitions effects fry generic help help.markup help.stylesheet
help.topics io io.files io.pathnames io.styles kernel macros
make namespaces prettyprint sequences sets sorting summary
tools.vocabs vocabs vocabs.loader words words.symbol
combinators.smart definitions.icons ;
IN: tools.vocabs.browser

: <$pretty-link> ( definition -- element )
    [
        [ definition-icon 1array \ $image prefix ]
        [ drop " " ]
        [ 1array \ $definition-link prefix ]
        tri
    ] output>array ;

: vocab-row ( vocab -- row )
    [ <$pretty-link> ] [ vocab-summary ] bi 2array ;

: vocab-headings ( -- headings )
    {
        { $strong "Vocabulary" }
        { $strong "Summary" }
    } ;

: root-heading ( root -- )
    [ "Children from " prepend ] [ "Children" ] if*
    $heading ;

: $vocabs ( seq -- )
    [ vocab-row ] map vocab-headings prefix $table ;

: $vocab-roots ( assoc -- )
    [
        [ drop ] [ [ root-heading ] [ $vocabs ] bi* ] if-empty
    ] assoc-each ;

TUPLE: vocab-tag name ;

INSTANCE: vocab-tag topic

C: <vocab-tag> vocab-tag

: $tags ( seq -- ) [ <vocab-tag> ] map $links ;

TUPLE: vocab-author name ;

INSTANCE: vocab-author topic

C: <vocab-author> vocab-author

: $authors ( seq -- ) [ <vocab-author> ] map $links ;

: describe-help ( vocab -- )
    [
        dup vocab-help
        [ "Documentation" $heading ($link) ]
        [ "Summary" $heading vocab-summary print-element ]
        ?if
    ] unless-empty ;

: describe-children ( vocab -- )
    vocab-name all-child-vocabs $vocab-roots ;

: describe-files ( vocab -- )
    vocab-files [ <pathname> ] map [
        "Files" $heading
        [
            snippet-style get [
                code-style get [
                    stack.
                ] with-nesting
            ] with-style
        ] ($block)
    ] unless-empty ;

: describe-tuple-classes ( classes -- )
    [
        "Tuple classes" $subheading
        [
            [ <$pretty-link> ]
            [ superclass <$link> ]
            [ "slots" word-prop [ name>> ] map " " join <$snippet> ]
            tri 3array
        ] map
        { { $strong "Class" } { $strong "Superclass" } { $strong "Slots" } } prefix
        $table
    ] unless-empty ;

: describe-predicate-classes ( classes -- )
    [
        "Predicate classes" $subheading
        [
            [ <$pretty-link> ]
            [ superclass <$link> ]
            bi 2array
        ] map
        { { $strong "Class" } { $strong "Superclass" } } prefix
        $table
    ] unless-empty ;

: (describe-classes) ( classes heading -- )
    '[
        _ $subheading
        [ <$pretty-link> 1array ] map $table
    ] unless-empty ;

: describe-builtin-classes ( classes -- )
    "Builtin classes" (describe-classes) ;

: describe-singleton-classes ( classes -- )
    "Singleton classes" (describe-classes) ;

: describe-mixin-classes ( classes -- )
    "Mixin classes" (describe-classes) ;

: describe-union-classes ( classes -- )
    "Union classes" (describe-classes) ;

: describe-intersection-classes ( classes -- )
    "Intersection classes" (describe-classes) ;

: describe-classes ( classes -- )
    [ builtin-class? ] partition
    [ tuple-class? ] partition
    [ singleton-class? ] partition
    [ predicate-class? ] partition
    [ mixin-class? ] partition
    [ union-class? ] partition
    [ intersection-class? ] filter
    {
        [ describe-builtin-classes ]
        [ describe-tuple-classes ]
        [ describe-singleton-classes ]
        [ describe-predicate-classes ]
        [ describe-mixin-classes ]
        [ describe-union-classes ]
        [ describe-intersection-classes ]
    } spread ;

: word-syntax ( word -- string/f )
    \ $syntax swap word-help elements dup length 1 =
    [ first second ] [ drop f ] if ;

: describe-parsing ( words -- )
    [
        "Parsing words" $subheading
        [
            [ <$link> ]
            [ word-syntax dup [ <$snippet> ] when ]
            bi 2array
        ] map
        { { $strong "Word" } { $strong "Syntax" } } prefix
        $table
    ] unless-empty ;

: word-row ( word -- element )
    [ <$pretty-link> ]
    [ stack-effect dup [ effect>string <$snippet> ] when ]
    bi 2array ;

: word-headings ( -- element )
    { { $strong "Word" } { $strong "Stack effect" } } ;

: words-table ( words -- )
    [ word-row ] map word-headings prefix $table ;

: (describe-words) ( words heading -- )
    '[ _ $subheading words-table ] unless-empty ;

: describe-generics ( words -- )
    "Generic words" (describe-words) ;

: describe-macros ( words -- )
    "Macro words" (describe-words) ;

: describe-primitives ( words -- )
    "Primitives" (describe-words) ;

: describe-compounds ( words -- )
    "Ordinary words" (describe-words) ;

: describe-predicates ( words -- )
    "Class predicate words" (describe-words) ;

: describe-symbols ( words -- )
    [
        "Symbol words" $subheading
        [ <$link> 1array ] map $table
    ] unless-empty ;

: $words ( words -- )
    [<commit_msg>tools.vocabs.browser: use icons in more places<commit_after>! Copyright (C) 2007, 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes classes.builtin
classes.intersection classes.mixin classes.predicate
classes.singleton classes.tuple classes.union combinators
definitions effects fry generic help help.markup help.stylesheet
help.topics io io.files io.pathnames io.styles kernel macros
make namespaces prettyprint sequences sets sorting summary
tools.vocabs vocabs vocabs.loader words words.symbol
combinators.smart definitions.icons ;
IN: tools.vocabs.browser

: <$pretty-link> ( definition -- element )
    [
        [ definition-icon 1array \ $image prefix ]
        [ drop " " ]
        [ 1array \ $definition-link prefix ]
        tri
    ] output>array ;

: vocab-row ( vocab -- row )
    [ <$pretty-link> ] [ vocab-summary ] bi 2array ;

: vocab-headings ( -- headings )
    {
        { $strong "Vocabulary" }
        { $strong "Summary" }
    } ;

: root-heading ( root -- )
    [ "Children from " prepend ] [ "Children" ] if*
    $heading ;

: $vocabs ( seq -- )
    [ vocab-row ] map vocab-headings prefix $table ;

: $vocab-roots ( assoc -- )
    [
        [ drop ] [ [ root-heading ] [ $vocabs ] bi* ] if-empty
    ] assoc-each ;

TUPLE: vocab-tag name ;

INSTANCE: vocab-tag topic

C: <vocab-tag> vocab-tag

: $tags ( seq -- ) [ <vocab-tag> ] map $links ;

TUPLE: vocab-author name ;

INSTANCE: vocab-author topic

C: <vocab-author> vocab-author

: $authors ( seq -- ) [ <vocab-author> ] map $links ;

: describe-help ( vocab -- )
    [
        dup vocab-help
        [ "Documentation" $heading ($link) ]
        [ "Summary" $heading vocab-summary print-element ]
        ?if
    ] unless-empty ;

: describe-children ( vocab -- )
    vocab-name all-child-vocabs $vocab-roots ;

: describe-files ( vocab -- )
    vocab-files [ <pathname> ] map [
        "Files" $heading
        [
            snippet-style get [
                code-style get [
                    stack.
                ] with-nesting
            ] with-style
        ] ($block)
    ] unless-empty ;

: describe-tuple-classes ( classes -- )
    [
        "Tuple classes" $subheading
        [
            [ <$pretty-link> ]
            [ superclass <$pretty-link> ]
            [ "slots" word-prop [ name>> ] map " " join <$snippet> ]
            tri 3array
        ] map
        { { $strong "Class" } { $strong "Superclass" } { $strong "Slots" } } prefix
        $table
    ] unless-empty ;

: describe-predicate-classes ( classes -- )
    [
        "Predicate classes" $subheading
        [
            [ <$pretty-link> ]
            [ superclass <$pretty-link> ]
            bi 2array
        ] map
        { { $strong "Class" } { $strong "Superclass" } } prefix
        $table
    ] unless-empty ;

: (describe-classes) ( classes heading -- )
    '[
        _ $subheading
        [ <$pretty-link> 1array ] map $table
    ] unless-empty ;

: describe-builtin-classes ( classes -- )
    "Builtin classes" (describe-classes) ;

: describe-singleton-classes ( classes -- )
    "Singleton classes" (describe-classes) ;

: describe-mixin-classes ( classes -- )
    "Mixin classes" (describe-classes) ;

: describe-union-classes ( classes -- )
    "Union classes" (describe-classes) ;

: describe-intersection-classes ( classes -- )
    "Intersection classes" (describe-classes) ;

: describe-classes ( classes -- )
    [ builtin-class? ] partition
    [ tuple-class? ] partition
    [ singleton-class? ] partition
    [ predicate-class? ] partition
    [ mixin-class? ] partition
    [ union-class? ] partition
    [ intersection-class? ] filter
    {
        [ describe-builtin-classes ]
        [ describe-tuple-classes ]
        [ describe-singleton-classes ]
        [ describe-predicate-classes ]
        [ describe-mixin-classes ]
        [ describe-union-classes ]
        [ describe-intersection-classes ]
    } spread ;

: word-syntax ( word -- string/f )
    \ $syntax swap word-help elements dup length 1 =
    [ first second ] [ drop f ] if ;

: describe-parsing ( words -- )
    [
        "Parsing words" $subheading
        [
            [ <$pretty-link> ]
            [ word-syntax dup [ <$snippet> ] when ]
            bi 2array
        ] map
        { { $strong "Word" } { $strong "Syntax" } } prefix
        $table
    ] unless-empty ;

: word-row ( word -- element )
    [ <$pretty-link> ]
    [ stack-effect dup [ effect>string <$snippet> ] when ]
    bi 2array ;

: word-headings ( -- element )
    { { $strong "Word" } { $strong "Stack effect" } } ;

: words-table ( words -- )
    [ word-row ] map word-headings prefix $table ;

: (describe-words) ( words heading -- )
    '[ _ $subheading words-table ] unless-empty ;

: describe-generics ( words -- )
    "Generic words" (describe-words) ;

: describe-macros ( words -- )
    "Macro words" (describe-words) ;

: describe-primitives ( words -- )
    "Primitives" (describe-words) ;

: describe-compounds ( words -- )
    "Ordinary words" (describe-words) ;

: describe-predicates ( words -- )
    "Class predicate words" (describe-words) ;

: describe-symbols ( words -- )
    [
        "Symbol words" $subheading
        [ <$pretty-link> 1array ] map $table
    ] unless-empty ;

: $words ( words -- )
    [
{'fraction_non_alphanumeric': 0.1392381132432177, 'fraction_numerical': 0.003402968144437092, 'mean_word_length': 2.1135962330782814, 'pattern_counts': {'":': 0, '<': 41, '<?xml version=': 0, '>': 49, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3618171', 'n_tokens_mistral': 3426, 'n_tokens_neox': 3326, 'n_words': 745}