blob: 92b2f250d981a1973b473231b85890b570615ad9 (
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
96
97
98
99
100
101
102
103
104
105
|
;;; Copyright © 2019 - 2023 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 dynamic util)
#:use-module (ice-9 match)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (web uri)
#:export (assoc-value
acons-normalize
base64-length
decode-form
date<?
hash-append!))
(define (assoc-value alist key)
"Return the `car' of `(assoc alist key)' if truthy"
(let ((result (assoc-ref alist key)))
(if result (car result) result)))
(define (acons-list k v alist)
"Add V to K to alist as list"
(let ((value (assoc-ref alist k)))
(if value
(let ((alist (alist-delete k alist)))
(acons k (cons v value) alist))
(acons k (list v) alist))))
(define (acons-normalize key value alist)
"Add KEY -> VALUE to ALIST such that no entries for KEY are duplicates"
(cons (cons key value)
(filter (lambda (pair) (not (equal? (car pair) key))) alist)))
(define (list->alist lst)
"Build a alist of list based on a list of key and values.
Multiple values can be associated with the same key"
(let next ((lst lst)
(out '()))
(if (null? lst)
out
(next (cdr lst) (acons-list (caar lst) (cdar lst) out)))))
(define (decode-form bv)
"Convert BV querystring or form data to an alist"
(define string (if (string? bv) bv (utf8->string bv)))
(define pairs (map (cut string-split <> #\=)
;; semi-colon and amp can be used as pair separator
(append-map (cut string-split <> #\;)
(string-split string #\&))))
(list->alist (map (match-lambda
((key value)
(cons (uri-decode key) (uri-decode value)))) pairs)))
(define (base64-length n)
"The length of the base64 string encoding `n' bytes."
(inexact->exact (* 4 (ceiling (/ n 3.0)))))
(define (date<? d1 d2)
"Return #t if D2 specifies a later date than D1"
(time<? (date->time-utc d1) (date->time-utc d2)))
(define (hash-append! table key item)
"Append ITEM to the list specified by KEY in TABLE
If KEY does not exist in TABLE, initialize kEY to (list ITEM)"
(if (hash-ref table key)
(hash-set! table key (cons item (hash-ref table key)))
(hash-set! table key (list item))))
(define (emoji? str)
"Determine if `str' is an 'acceptable' emoji character
Acceptable is the following subset:
- The 'Emoticons' block
- The 'Supplemental Symbols and Pictographs' block, excluding U+1F900
through U+1F90B
- The hand symbols from the 'Miscellaneous Symbols and Pictographs'
block
- The hand symbols from the 'Dingbats' block
Notably, U+1F946 isn't normally treated an emoji, but it is here. I
think it should be! As an American, I should be able to use pictographs
to express my God-given constitutional rights!"
(and (string str)
(= 1 (string-length str))
(let ((codepoint (char->integer
(first (string->list str)))))
(and (>= codepoint #x1F600) (<= codepoint #x1F64F)))))
|
