<commit_before>! Copyright (C) 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators furnace.utilities
html.components html.forms html.templates
html.templates.chloe.compiler html.templates.chloe.syntax kernel
namespaces present sequences splitting urls xml.data xml.syntax
xml.traversal xml.writer ;
IN: furnace.chloe-tags

! Chloe tags
: parse-query-attr ( string -- assoc )
    [ f ] [ "," split [ dup value ] H{ } map>assoc ] if-empty ;

: a-url-path ( href rest -- string )
    dup [ value ] when
    [ [ "/" ?tail drop "/" ] dip present 3append ] when* ;

: a-url ( href rest query value-name -- url )
    dup [ 3nip value ] [
        drop
        <url>
            swap parse-query-attr >>query
            -rot a-url-path >>path
        adjust-url
    ] if ;

: compile-a-url ( tag -- )
    {
        [ "href" optional-attr compile-attr ]
        [ "rest" optional-attr compile-attr ]
        [ "query" optional-attr compile-attr ]
        [ "value" optional-attr compile-attr ]
    } cleave [ a-url ] [code] ;

CHLOE: atom
    [ compile-children>xml-string ] [ compile-a-url ] bi
    [ add-atom-feed ] [code] ;

CHLOE: write-atom drop [ write-atom-feeds ] [code] ;

: compile-link-attrs ( tag -- )
    ! Side-effects current namespace.
    '[ [ [ _ ] dip link-attr ] each-responder ] [code] ;

: process-attrs ( assoc -- newassoc )
    [ "@" ?head [ value present ] when ] assoc-map ;

: non-chloe-attrs ( tag -- )
    attrs>> non-chloe-attrs-only [ process-attrs ] [code-with] ;

: a-attrs ( tag -- )
    [ non-chloe-attrs ]
    [ compile-link-attrs ]
    [ compile-a-url ] tri
    [ present swap "href" swap [ set-at ] keep ] [code] ;

CHLOE: a
    [
        [ a-attrs ]
        [ compile-children>xml-string ] bi
        [ <unescaped> [XML <a><-></a> XML] second swap >>attrs ]
        [xml-code]
    ] compile-with-scope ;

CHLOE: base
    compile-a-url [ [XML <base href=<->/> XML] ] [xml-code] ;

: hidden-nested-fields ( -- xml )
    nested-forms get join-words f like nested-forms-key
    hidden-form-field ;

: render-hidden ( for -- xml )
    [ "," split [ hidden render>xml ] map ] [ f ] if* ;

: compile-hidden-form-fields ( for -- )
    '[
        _ render-hidden
        hidden-nested-fields
        form-modifications
        [XML <div style="display: none;"><-><-><-></div> XML]
    ] [code] ;

: (compile-form-attrs) ( method action -- )
    ! Leaves an assoc on the stack at runtime
    [ compile-attr [ "method" pick set-at ] [code] ]
    [ compile-attr [ resolve-base-path "action" pick set-at ] [code] ]
    bi* ;

: compile-method/action ( tag -- )
    ! generated code is ( assoc -- assoc )
    [ "method" optional-attr "post" or ]
    [ "action" required-attr ] bi
    (compile-form-attrs) ;

: compile-form-attrs ( tag -- )
    [ non-chloe-attrs ]
    [ compile-link-attrs ]
    [ compile-method/action ] tri ;

: hidden-fields ( tag -- )
    "for" optional-attr compile-hidden-form-fields ;

CHLOE: form
    [
        [ compile-form-attrs ]
        [ hidden-fields ]
        [ compile-children>xml-string ] tri
        [
            <unescaped> [XML <form><-><-></form> XML] first
                swap >>attrs
            write-xml
        ] [code]<commit_msg>Revert "furnace.chloe-tags: change indexing now that empty strings are not included"<commit_after>! Copyright (C) 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators furnace.utilities
html.components html.forms html.templates
html.templates.chloe.compiler html.templates.chloe.syntax kernel
namespaces present sequences splitting urls xml.data xml.syntax
xml.traversal xml.writer ;
IN: furnace.chloe-tags

! Chloe tags
: parse-query-attr ( string -- assoc )
    [ f ] [ "," split [ dup value ] H{ } map>assoc ] if-empty ;

: a-url-path ( href rest -- string )
    dup [ value ] when
    [ [ "/" ?tail drop "/" ] dip present 3append ] when* ;

: a-url ( href rest query value-name -- url )
    dup [ 3nip value ] [
        drop
        <url>
            swap parse-query-attr >>query
            -rot a-url-path >>path
        adjust-url
    ] if ;

: compile-a-url ( tag -- )
    {
        [ "href" optional-attr compile-attr ]
        [ "rest" optional-attr compile-attr ]
        [ "query" optional-attr compile-attr ]
        [ "value" optional-attr compile-attr ]
    } cleave [ a-url ] [code] ;

CHLOE: atom
    [ compile-children>xml-string ] [ compile-a-url ] bi
    [ add-atom-feed ] [code] ;

CHLOE: write-atom drop [ write-atom-feeds ] [code] ;

: compile-link-attrs ( tag -- )
    ! Side-effects current namespace.
    '[ [ [ _ ] dip link-attr ] each-responder ] [code] ;

: process-attrs ( assoc -- newassoc )
    [ "@" ?head [ value present ] when ] assoc-map ;

: non-chloe-attrs ( tag -- )
    attrs>> non-chloe-attrs-only [ process-attrs ] [code-with] ;

: a-attrs ( tag -- )
    [ non-chloe-attrs ]
    [ compile-link-attrs ]
    [ compile-a-url ] tri
    [ present swap "href" swap [ set-at ] keep ] [code] ;

CHLOE: a
    [
        [ a-attrs ]
        [ compile-children>xml-string ] bi
        [ <unescaped> [XML <a><-></a> XML] second swap >>attrs ]
        [xml-code]
    ] compile-with-scope ;

CHLOE: base
    compile-a-url [ [XML <base href=<->/> XML] ] [xml-code] ;

: hidden-nested-fields ( -- xml )
    nested-forms get join-words f like nested-forms-key
    hidden-form-field ;

: render-hidden ( for -- xml )
    [ "," split [ hidden render>xml ] map ] [ f ] if* ;

: compile-hidden-form-fields ( for -- )
    '[
        _ render-hidden
        hidden-nested-fields
        form-modifications
        [XML <div style="display: none;"><-><-><-></div> XML]
    ] [code] ;

: (compile-form-attrs) ( method action -- )
    ! Leaves an assoc on the stack at runtime
    [ compile-attr [ "method" pick set-at ] [code] ]
    [ compile-attr [ resolve-base-path "action" pick set-at ] [code] ]
    bi* ;

: compile-method/action ( tag -- )
    ! generated code is ( assoc -- assoc )
    [ "method" optional-attr "post" or ]
    [ "action" required-attr ] bi
    (compile-form-attrs) ;

: compile-form-attrs ( tag -- )
    [ non-chloe-attrs ]
    [ compile-link-attrs ]
    [ compile-method/action ] tri ;

: hidden-fields ( tag -- )
    "for" optional-attr compile-hidden-form-fields ;

CHLOE: form
    [
        [ compile-form-attrs ]
        [ hidden-fields ]
        [ compile-children>xml-string ] tri
        [
            <unescaped> [XML <form><-><-></form> XML] second
                swap >>attrs
            write-xml
        ] [code]
{'fraction_non_alphanumeric': 0.1554980201035638, 'fraction_numerical': 0.0018275967103259215, 'mean_word_length': 2.1617717862301395, 'pattern_counts': {'":': 0, '<': 39, '<?xml version=': 0, '>': 69, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 26}, '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': '2223031', 'n_tokens_mistral': 2221, 'n_tokens_neox': 2189, 'n_words': 521}