;;; Copyright © 2019 - 2022 Jakob L. Kreuze ;;; ;;; 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 ;;; . (define-module (dynamic util) #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (web uri) #:export (assoc-value acons-normalize base64-length decode-form)) (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)))))