blob: a41d21ae48928a339f9833dd7e638a171e1e8fd2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
;;; Copyright © 2019 - 2020 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(define-module (jakob utils)
#:use-module (haunt post)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:export (maybe-cons*
maybe-list
date->string*
intersperse
first-paragraph
description-from-post))
(define (maybe-list . args)
"Create a list of all ARGS that are neither #f nor unspecified."
(remove (lambda (element)
(or (not element) (unspecified? element)))
args))
(define (maybe-cons* . args)
"Cons all ARGS that are neither #f nor unspecified."
(apply cons* (apply maybe-list args)))
(define (date->string* date)
"Convert DATE to human readable string."
(date->string date "~a ~d ~B ~Y"))
(define (intersperse lst delim)
"Return the elements of LST delimited by DELIM, such that the resultant list
is of an odd length and every second element is DELIM."
(if (<= (length lst) 1)
lst
(cons* (car lst)
delim
(intersperse (cdr lst) delim))))
(define (remove-footnote-references content)
"Remove any <sup> elements from CONTENT."
(map (lambda (elt)
(if (list? elt)
(remove-footnote-references elt)
elt))
(remove (lambda (elt)
(and (list? elt) (eq? 'sup (car elt))))
content)))
(define (first-paragraph post)
(let loop ((sxml (post-sxml post))
(result '()))
(match sxml
(() (remove-footnote-references (reverse result)))
((or (('p ...) tail ...) (paragraph tail ...))
(if (and (list? paragraph) (eqv? 'header (car paragraph)))
(loop tail result) ; Ignore front-matter.
(remove-footnote-references (reverse (cons paragraph result)))))
((head . tail)
(loop tail (cons head result))))))
(define (description-from-post post)
(define (first-elem sxml)
(if (and (list? sxml) (positive? (length sxml)))
(if (symbol? (first sxml))
sxml
(let ((reduced (remove null? (map first-elem sxml))))
(if (positive? (length reduced))
(first reduced)
'())))
'()))
(define (collect-strings elt res)
(cond ((null? elt) res)
((string? (car elt)) (collect-strings (cdr elt) (cons (car elt) res)))
((list? (car elt)) (if (and (positive? (length (car elt)))
(not (eq? '@ (caar elt))))
(let ((nested (collect-strings (car elt) (list))))
(collect-strings (cdr elt) (append nested res)))
(collect-strings (cdr elt) res)))
(else (collect-strings (cdr elt) res))))
(let* ((sxml (first-paragraph post))
(extracted (collect-strings (first-elem sxml) (list))))
(string-join (map string-trim-both (reverse extracted)) " ")))
|
