! Copyright (C) 2025 Serre
! See https://factorcode.org/license.txt for BSD license.
! Painfully inelegant, but it works so I refuse to futz
! over the details any further.
USING: accessors arrays assocs backticks combinators csv
generalizations io io.directories io.encodings.utf8 io.files
io.pathnames io.streams.string kernel math math.parser
present sequences sequences.generalizations splitting unicode
erinnemori-2.utils ;
IN: erinnemori-2.posts
CONSTANT: boards-path "resource:/www-data/boards/"
: topics-path ( board -- path )
boards-path prepend "/" append ;
: thread-path ( topic board -- path )
topics-path prepend "/" append ;
: content-in ( topic board -- files )
thread-path ?qualified-directory-files ;
CONSTANT: post-values
{ "index" "author" "title/f" "body" "images" "tags" "date" }
: posts-in ( topic board -- posts )
content-in [ "p#" subseq-of? ] filter
post-values zip-pile [ "index" of string>number ] sort-by ;
: posts-dex ( topic board -- indices )
content-in [ "p#" subseq-of? ] filter
[ utf8 [ read-row ] with-file-reader first ] map ;
: posts-in* ( topic-alist -- posts )
[ "index" of ] [ "board" of ] bi posts-in ;
: expunged-in ( topic board -- expunged )
content-in [ "e#" subseq-of? ] filter
post-values zip-pile ;
: next-index ( topic board -- int-string )
[ posts-in ] [ expunged-in ] 2bi [ length ] bi@ 1 + +
present ;
: add-post ( topic board index seq -- )
[ thread-path ] 2dip [ "p#" ".csv" surround append ] dip
swap [ touch-file ] keep
utf8 [ write-row ] with-file-writer ;
: <post> ( board topic author title body images tags
-- post-csv )
[ swap 2dup next-index dup ] 5 ndip
` date +%s ` but-last 7 narray [ add-post ] keep ;
CONSTANT: topic-values
{ "index" "board" "title" "admin" "mod-status" }
: new-topic ( board -- topic )
topics-path
[ qualified-directory-files length 1 + present ]
keep dupd prepend make-directory ;
: populate-topic ( topic board title admin -- )
[ 2dup ] 2dip "" 5 narray
[ thread-path "thread.csv" append ]
dip swap [ touch-file ] keep
utf8 [ write-row ] with-file-writer ;
: touch-resources ( topic board -- )
thread-path "resources.csv" append touch-file ;
DEFER: topic-link
:: <topic> ( board author title body images tags -- link )
board new-topic :> t'
t' board title author populate-topic
t' board touch-resources
board t' author title body images tags <post> drop
t' board topic-link ;
: board-topics ( board -- topics )
topics-path qualified-directory-files
[ "/thread.csv" append utf8 [ read-row ] with-file-reader
topic-values swap zip
] map
[ "mod-status" of "expunge" = ] reject ;
: topic-op ( topic board -- post )
thread-path "p#1.csv" append
utf8 [ read-row ] with-file-reader
post-values swap zip ;
: topic-link ( topic board -- link )
thread-path path-components 2 tail* "/"
[ append-path ] reduce ;
: topic-link* ( topic-alist -- link )
[ "index" of ] [ "board" of ] bi topic-link ;
: topic-data ( topic board -- topic-alist )
thread-path "/thread.csv" append
utf8 [ read-row ] with-file-reader topic-values swap zip ;
: post@ ( board topic-index post-index -- post link filepath )
swapd
[ [ posts-in ] dip '[ "index" of _ = ] filter ?first ]
[ [ topic-link "#" append ] dip append ]
[ [ thread-path ] dip "p#" ".csv" surround append ]
3tri ;
: expunge-post ( board topic post -- )
post@ 2nip dup "p#" "e#" replace move-file ;
: unwrap-thread ( board thread-index -- post-links )
swap [ posts-dex ] [ [ spin post@ 3array ] 2curry ]
2bi map ;
: unwrap-board ( board -- post-links )
[ board-topics [ "index" of ] map ]
[ [ swap unwrap-thread ] curry ] bi map concat ;
: all-posts ( boards -- post-links )
[ unwrap-board ] map concat [ first ] filter ;
:: replace-post ( board topic index
author title body images tags -- )
` date +%s ` but-last :> date'
title " (ed.)" append :> title'
topic board index
{ index author title' body images tags date' }
add-post ;
: <tag ( tag -- posts )
[ { "projects" "dilletante" } all-posts ] dip
'[ first "tags" of string>csv concat
_ swap member? ] filter ;
CONSTANT: resource-values { "link" "desc" }
: topic>resources ( topic board -- resources )
thread-path "resources.csv" append utf8 file>csv ;
: topic>resources* ( post-alist -- resources )
[ "index" of ] [ "board" of ] bi topic>resources ;
: add-resource ( topic board link desc -- )
[ thread-path "resources.csv" append ]
2dip 2array swap
utf8 [ write-row ] with-file-appender ;