From 1b2b7c3eb939724696894f31ff27db97b0cac84c Mon Sep 17 00:00:00 2001 From: Andreas Widen Date: Sat, 25 Nov 2023 17:21:37 +0100 Subject: Initial commit. Signed-off-by: Andreas Widen --- apps/aux/lists.scm | 67 ++++++++++++++++++++++++++++++++++++++++++++++++++++ apps/aux/numbers.scm | 31 ++++++++++++++++++++++++ apps/aux/strings.scm | 12 ++++++++++ apps/aux/sxml.scm | 23 ++++++++++++++++++ apps/aux/system.scm | 32 +++++++++++++++++++++++++ apps/aux/web.scm | 61 +++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 226 insertions(+) create mode 100644 apps/aux/lists.scm create mode 100644 apps/aux/numbers.scm create mode 100644 apps/aux/strings.scm create mode 100644 apps/aux/sxml.scm create mode 100644 apps/aux/system.scm create mode 100644 apps/aux/web.scm (limited to 'apps/aux') diff --git a/apps/aux/lists.scm b/apps/aux/lists.scm new file mode 100644 index 0000000..634d1e4 --- /dev/null +++ b/apps/aux/lists.scm @@ -0,0 +1,67 @@ +;;; Harmonic Flow web site + +(define-module (apps aux lists) + #:use-module (apps aux numbers) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-27) + #:export (list-group + list-slice + rest + separate + take-random)) + + +(define (list-group los limit) + (map (lambda (index) + (list-slice los index (+ index limit))) + ;; TODO: Use a skip-count procedure instead of iota. + (iota (ceiling (/ (length los) limit)) 0 limit))) + + +(define* (list-slice los index-a #:optional (index-b #false)) + (let ((start index-a) + (end (if (or (not index-b) (> index-b (length los))) + (- (length los) 1) + (- index-b 1)))) + (map (lambda (index) + (list-ref los index)) + (range index-a end)))) + + +(define (rest los) + (cond ((<= (length los) 1) (list)) + (else (list-tail los 1)))) + + +(define (separate los separator) + "Return a list with the elements of LOS separated by SEPARATOR. + + LOS (list) + A list of s-expressions. + + SEPARATOR (s-expression) + Any s-expression that will be added between the elements of the + given list. + + RETURN VALUE (list) + A list of s-expressions." + (cond ((or (null? los) (= (length los) 1)) los) + (else + (cons (first los) + (cons separator (separate (rest los) separator)))))) + +(define (take-random list n) + "Return a list containing N different elements from LIST, if +possible, chosen randomly and evenly distributed. If LIST has less +than N elements, the result is a permutation of LIST." + (let loop ((list list) + (n n) + (len (length list))) + (if (<= (min n len) 0) + '() + (let ((r (random-integer len))) + (cons (list-ref list r) + (loop (append (take list r) + (drop list (1+ r))) + (- len 1) + (- n 1))))))) diff --git a/apps/aux/numbers.scm b/apps/aux/numbers.scm new file mode 100644 index 0000000..6c83dcb --- /dev/null +++ b/apps/aux/numbers.scm @@ -0,0 +1,31 @@ +;;; Harmonic Flow web site + +(define-module (apps aux numbers) + #:use-module (srfi srfi-1) + #:export (minus-one + plus-one + range)) + + +(define (minus-one n) + "Return N-1." + (- n 1)) + + +(define (plus-one n) + "Return N+1." + (+ n 1)) + + +(define (range a b) + "Return the list of integers in the range [A, B]. + + A (integer) + + B (integer) + + RETURN VALUE (list of integers) + For example, for the range [-2, 3], return + (list -2 -1 0 1 2 3)." + (cond ((zero? (- a b)) (cons a (list))) + (else (cons a (range (plus-one a) b))))) diff --git a/apps/aux/strings.scm b/apps/aux/strings.scm new file mode 100644 index 0000000..7004721 --- /dev/null +++ b/apps/aux/strings.scm @@ -0,0 +1,12 @@ +;;; Harmonic Flow web site + +(define-module (apps aux strings) + #:export (string-summarize)) + + +(define (string-summarize string n) + "Return an extract of N words from the given STRING." + (let ((words (string-split string #\space))) + (if (<= (length words) n) + string + (string-join (list-head words n) " ")))) diff --git a/apps/aux/sxml.scm b/apps/aux/sxml.scm new file mode 100644 index 0000000..531cdee --- /dev/null +++ b/apps/aux/sxml.scm @@ -0,0 +1,23 @@ +;;; Harmonic Flow web site + +(define-module (apps aux sxml) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (sxml->string*)) + + +(define (sxml->string* tree) + "Flatten tree by dismissing tags and attributes, and return the resulting +string." + (define (sxml->strings tree) + (match tree + (((? symbol?) ('@ _ ...) body ...) + (append-map sxml->strings `(" " ,@body " "))) + (((? symbol?) body ...) + (append-map sxml->strings `(" " ,@body " "))) + ((? string?) + (list tree)) + ((lst ...) + (sxml->strings `(div ,@lst))))) + + (string-concatenate (sxml->strings tree))) diff --git a/apps/aux/system.scm b/apps/aux/system.scm new file mode 100644 index 0000000..ee9a5a3 --- /dev/null +++ b/apps/aux/system.scm @@ -0,0 +1,32 @@ +;;; Harmonic Flow web site + +(define-module (apps aux system) + #:export (path-join)) + + +;;; +;;; Procedures. +;;; + +(define (path-join . parts) + "Return a system path composed of the given PARTS. + + PARTS (strings) + A succession of strings representing parts of a file system path. + + To indicate an absolute path, use an empty string as the first + part. For example: + + (path-join '' 'docs' 'manual') + => '/docs/manual' + + To end the path with a slash, use an empty string as the last + part. For example: + + (path-join '' 'docs' 'manual' '') + => '/docs/manual/' + + RETURN VALUE (string) + A string representing a file system path." + (cond ((equal? parts '("")) "/") ; Root directory + (else (string-join parts file-name-separator-string)))) diff --git a/apps/aux/web.scm b/apps/aux/web.scm new file mode 100644 index 0000000..fec6b4c --- /dev/null +++ b/apps/aux/web.scm @@ -0,0 +1,61 @@ +;;; Harmonic Flow web site + +(define-module (apps aux web) + #:use-module (srfi srfi-1) + #:export (slugify + url-path-join)) + + +;;; +;;; Variables. +;;; + +(define char-set:slug + (char-set-union char-set:letter+digit (char-set #\-))) + + + +;;; +;;; Procedures. +;;; + +(define (slugify text) + "Return TEXT as a slug. + + Reserved characters for Internationalized Resource Identifiers + (IRIs) and common reserved characters for file names are removed + using the SLUG_FORBIDDEN constant as reference. + + TEXT (string) + Some text. For example: Biology, Human anatomy. + + RETURN VALUE (string) + A slug-like string. For example: biology, human-anatomy." + (string-join + (map (lambda (s) (string-filter char-set:slug s)) + (string-split (string-downcase text) char-set:whitespace)) + "-")) + + +(define (url-path-join . parts) + "Return a URL path composed of the given PARTS. + + PARTS (strings) + A succession of strings that represent parts of a URL path. + + To indicate an absolute path, use an empty string as the first + part. For example: + + (url-path-join '' 'docs' 'manual') + => '/docs/manual' + + To end the path with a slash, use an empty string as the last + part. For example: + + (url-path-join '' 'docs' 'manual' '') + => '/docs/manual/' + + RETURN VALUE (string) + A string representing a URL path." + (cond ((equal? parts '("")) "/") ; Root directory + (else (string-join parts "/")))) -- cgit v1.2.3-54-g00ecf