about summary refs log tree commit diff
path: root/kaakaa/lens.scm
blob: f5c937009d7dbae267061386bac5a08cf6ca3bc5 (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
;;; kaakaa --- Tiny, security-focused AI agent in Guile
;;; Copyright © 2026 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of kaakaa.
;;;
;;; kaakaa 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.
;;;
;;; kaakaa 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 kaakaa.  If not, see <https://www.gnu.org/licenses/>.

(define-module (kaakaa lens)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-43)
  #:use-module (lens)
  #:export (vector-nth
            in-json
            push
            prepend-over
            alist-delete-over))

(define (vector-nth n)
  "Like @code{nth}, but for vectors."
  (lens (cut vector-ref <> n)
        (lambda (vec proc)
          (vector-append (vector-copy vec 0 n)
                         (vector (proc (vector-ref vec n)))
                         (vector-copy vec (1+ n))))))

(define in-json
  (case-lambda
    "Like @code{in}, but also allow integer components so that it is
possible to traverse JSON trees."
    (() (id))
    ((key . tail)
     (compose (apply in-json tail)
              (if (string? key)
                  (key-ref key)
                  (vector-nth key))))))

(define (push lens x object)
  "Cons @var{x} onto the part of @var{object} that @var{lens} focuses
on."
  (over lens (cut cons x <>) object))

(define (prepend-over lens lst object)
  "Prepend @var{lst} to the part of @var{object} that @var{lens} focuses
on."
  (over lens (cut append lst <>) object))

(define (alist-delete-over lens key object)
  "Delete @var{key} from the association list in @var{object} that
@var{lens} focuses on."
  (over lens (cut alist-delete key <>) object))