0.0.0.0:80 erinnemori-2 / master posts / posts.factor
master

Tree @master (Download .tar.gz)

posts.factor @masterraw · history · blame

! 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 ;