#lang racket/base
(require file/sha1
pollen/core
racket/file
racket/list
racket/string
threading
txexpr)
(provide (all-defined-out))
;; Convert a string into all lowercase, delete all non-alphanum chars, replace spaces with ‘-’
(define (normalize-key str)
(~> (string-downcase str)
(regexp-replace #rx"ies$" _ "y")
(string-trim "s" #:left? #f)
(regexp-replace* #rx"[^A-Za-z0-9 ]" _ "")
(string-normalize-spaces #px"\\s+" "-")))
;; ~~ Metas reference and updating ~~~~~~~~~~~~~~~
;; Computes a unique string key for the current Pollen source and stashes it in the metas
(define (here-key [suffix ""])
(define metas (current-metas))
(define (set-here-key!)
(set-meta 'here-key
(~> (hash-ref metas 'here-path)
string->bytes/utf-8
sha1-bytes
bytes->hex-string
(substring 0 8))))
(string-append (hash-ref metas 'here-key set-here-key!) suffix))
;;
;; Meta tools ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define (meta-set? key)
(and (hash-ref (current-metas) key #f) #t))
(define (set-meta key val)
(current-metas (hash-set (current-metas) key val))
val)
(define (update-meta key proc default)
(let ([updated (proc (hash-ref (current-metas) key default))])
(set-meta key updated)))
(define (cons-to-metas-list key val)
(define consed (cons val (hash-ref (current-metas) key '())))
(current-metas (hash-set (current-metas) key consed))
consed)
(define (update-metas-subhash key subkey val [proc (λ (v) v)])
(define metas (current-metas))
(define subhash (hash-ref metas key hasheq))
(set-meta key (hash-set subhash subkey (proc val))))
(define (get-metas-subhash key subkey)
(hash-ref (hash-ref (current-metas) key #hasheq()) subkey #f))
;; Returns a function will test if a txexpr's tag matches the given symbol and
;; (optionally) contains all given attributes.
(define (tx-is? t #:has-attrs [a '()])
(define tags (if (list? t) t (list t)))
(define attrs (if (list? a) a (list a)))
(lambda (v)
(and (txexpr? v)
(member (get-tag v) tags)
(andmap (λ (attr) (attrs-have-key? a attr)) attrs)
#t)))
;; “Notes”, in addition to being attached to/contained in articles, are also
;; shown alongside articles in the chronological feed. To make building this
;; mixed chronological feed faster, articles and notes create files in a
;; “serialize” subfolder at compile time:
;; * The filenames are prefixed with the thing’s YMD date.
;; * Note-files contain a datum of the entire note.
;; * Article-files contain only the path to the article’s source.
;;
;; This way building the chrono feed is simple and doesn’t require loading
;; and sorting the docs/metas of the entire article set.
(define serialize-folder "compiled/.serialized")
(define (current-serialize-folder-path)
(and~> (hash-ref (current-metas) 'here-path #f)
explode-path
(drop-right 1)
(append (list serialize-folder))
(apply build-path _)))
;;
;; TODO: Possible speed gains by spawning a thread to do this
(define (serialize-article-placeholder)
(let* ([ser-folder (current-serialize-folder-path)]
[filename (format "~a.article" (hash-ref (current-metas) 'published))]
[placeholder (build-path ser-folder filename)])
(unless (directory-exists? ser-folder) (make-directory ser-folder))
(unless (file-exists? placeholder)
(write-to-file (hash-ref (current-metas) 'here-path)
(build-path ser-folder filename)
#:exists 'truncate))))
(define (serialize-note note num)
(let ([ser-folder (current-serialize-folder-path)]
[filename (format "~a_~a.note" (attr-ref note 'date) num)])
(unless (directory-exists? ser-folder) (make-directory ser-folder))
(write-to-file note (build-path ser-folder filename) #:exists 'truncate)))
