Paste: Snarl (WIP)

! Copyright (C) 2023 CapitalEx.
! See https://factorcode.org/license.txt for BSD license.
USING: accessors assocs html.components html.forms
html.templates html.templates.chloe
html.templates.chloe.components html.templates.chloe.syntax
interpolate io.directories io.encodings.utf8 io.files
io.streams.string kernel namespaces sequences splitting unicode
xml.data xml.traversal ;
IN: snarl

: titlize ( name -- titlized ) "_-" split [ capitalize ] map! " " join ;

TUPLE: backlink name display url ;
: <backlink> ( name -- backlink ) 
    dup [ titlize ] [ I"${}.html" ] bi \ backlink boa ;

TUPLE: page name article ;
C: <page> page 

SYMBOLS: current-page ;
SYMBOLS: backlinks ;

! File interactions
: output-file ( page -- file-name ) name>> I"vocab:snarl/_static/${0}.html" ;
: page-farkup ( name -- farkup )    I"vocab:snarl/_wiki/pages/${0}.farkup" utf8 file-contents ; 
: pages       (      -- sequence ) "vocab:snarl/_wiki/pages" directory-files ;

! back linking
: ready-backlinks (                  --           ) H{ } clone backlinks set ;
: get-backlinks   ( name             -- backlinks ) backlinks get [ drop V{ } clone ] cache ;
: backlink        ( backlink current --           ) [ <backlink> ] dip "href" attr get-backlinks push ;

! setting form values
: set-backlinks ( page -- ) name>> get-backlinks 
                            dup        "backlinks"    set-value 
                            empty? not "has backlink" set-value ;
: set-title     ( page -- ) name>>     "title"    set-value ;
: set-article   ( page -- ) article>>  "article"  set-value ;

: save-links ( links -- links )
    dup current-page get '[ _ swap backlink  ] each ;

: suffix-html ( links -- )
    [ dup "href" attr I"${}.html" "href" set-attr ] each ;

: find-backlinks ( xml -- xml ) dup "a" deep-tags-named save-links suffix-html ;
 
! Construct Wiki
: page-name ( file-name -- page-name ) "." split1 drop dup current-page set ;

: build-template ( -- chloe )
    "vocab:snarl/_wiki/templates/wiki-page" <chloe> 
        [ call-template ] with-string-writer ;

: wiki-page ( name -- page )
    page-name dup page-farkup farkup>xml find-backlinks <page> ;

: write-html ( file-name html -- )
    swap output-file utf8 set-file-contents ;

: wiki-pages ( -- sequence )
    ready-backlinks pages [ wiki-page ] map ;

: compile-page ( page -- template )
    begin-form
        dup set-title dup set-article set-backlinks
    build-template ;

: compile-wiki ( -- )
    wiki-pages [ 
        [ compile-page ] [ output-file ] bi utf8 set-file-contents
    ] each ;