brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Load and expand raw members index.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-10 22:51:38 +01:00
parent 603ffa53bb
commit affb30d9b6
1 changed files with 33 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

48
brmsaptool.scm
View file

@ -30,7 +30,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Static default configuration
(define *members-directory* "members")
(define *members-directory* (make-parameter "members"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Testing
@ -110,19 +110,37 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Members index
(define (load-members-raw-index . dn)
(let ((dn (if (null? dn) *members-directory* (car dn))))
(let loop ((fns (directory dn))
(rs '()))
(if (null? fns)
rs
(let* ((fn (car fns))
(ffn (make-pathname dn fn))
(sl (if (symbolic-link? ffn) (read-symbolic-link ffn) #f)))
(loop (cdr fns)
(if sl
(cons (cons fn sl) rs)
rs)))))))
(define (load-members-raw-index)
(let loop ((fns (directory (*members-directory*)))
(rs '()))
(if (null? fns)
rs
(let* ((fn (car fns))
(ffn (make-pathname (*members-directory*) fn))
(sl (if (symbolic-link? ffn) (read-symbolic-link ffn) #f)))
(loop (cdr fns)
(if sl
(cons (cons fn sl) rs)
rs))))))
(define (members-expand-raw-index ri)
(let loop ((ri ri)
(ds '()))
(if (null? ri)
ds
(let* ((mp (car ri))
(lnk (car mp))
(dfn (cdr mp))
(lnkn (string->number lnk))
(dfnn (string->number dfn))
(id (or dfnn lnkn))
(name (if lnkn dfn lnk)))
(loop (cdr ri)
(cons (list (cons 'id id)
(cons 'name name)
(cons 'file dfn))
ds))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Run everything
@ -138,4 +156,4 @@
(newline)
;; Perform requested action
(print (load-members-raw-index))
(print (members-expand-raw-index (load-members-raw-index)))