! 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 ; : ( name -- backlink ) dup [ titlize ] [ I"${}.html" ] bi \ backlink boa ; TUPLE: page name article ; C: 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 -- ) [ ] 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" [ call-template ] with-string-writer ; : wiki-page ( name -- page ) page-name dup page-farkup farkup>xml find-backlinks ; : 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 ;