From 669c17123bc62939c8b76e80861121ec377d9bde Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Wed, 15 Mar 2023 12:37:03 +0100 Subject: [PATCH] Aliases and files recording. --- members-base.scm | 57 ++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 50 insertions(+), 7 deletions(-) diff --git a/members-base.scm b/members-base.scm index 08af2d8..e27bd83 100644 --- a/members-base.scm +++ b/members-base.scm @@ -37,7 +37,9 @@ (chicken pathname) (chicken file posix) (chicken file) + (chicken format) testing + utils dictionary) ;; Gets all files and symbolic links from given directory. The @@ -52,20 +54,50 @@ (ffn (make-pathname dn fn))) (loop (cdr fns) (if (symbolic-link? ffn) - (cons (cons fn (read-symbolic-link ffn)) rs) + (cons (cons (string->symbol fn) + (string->symbol (read-symbolic-link ffn))) + rs) (if (regular-file? ffn) - (cons fn rs) + (cons (string->symbol fn) rs) rs))))))) + ;; Converts a list of symlinks and files in aforementioned format + ;; into a dictionary of regular files as keys with lists of symlinks + ;; as values. If the target file does not exist, adds 'error-0 symbol + ;; as the first alias to this list with the number increasing with + ;; each nonexistent file encountered. The error record is also + ;; generated for symlinks pointing outside of the directory. (define (files+symlinks->files-dictionary ls) - (let ((links (filter pair? ls)) - (files (filter string? ls))) - (print links) - (print files))) + (let* ((links (filter pair? ls)) + (files (filter symbol? ls)) + (fdict + (let loop ((files files) + (res (make-dict))) + (if (null? files) + res + (loop (cdr files) + (dict-set res (car files) '())))))) + (let loop ((links links) + (res fdict) + (errs 0)) + (if (null? links) + res + (let* ((link (car links)) + (name (car link)) + (target (cdr link))) + (if (dict-has-key? res target) + (loop (cdr links) + (dict-set res target (cons name (dict-ref res target))) + errs) + (loop (cdr links) + (dict-set res target + (list (string->symbol (sprintf "error-~A" errs)) + name)) + (+ errs 1)))))))) (define (load-members dn) ;; get the directory contents - (files+symlinks->files-dictionary (get-files+symlinks dn)) + (print (files+symlinks->files-dictionary (get-files+symlinks dn))) ;; filter all ids ;; resolve links (it might be unknown!) ;; load member files @@ -74,6 +106,17 @@ (define (members-base-tests!) (run-tests members-base + (test-equal? files+symlinks->files-dictionary + (files+symlinks->files-dictionary + '(joe (2803 . joe))) + '((joe 2803))) + (test-equal? files+symlinks->files-dictionary + (files+symlinks->files-dictionary + '(joe + (2803 . joe) + (666 . nonexistent))) + '((nonexistent error-0 666) + (joe 2803))) )) )