;; ;; schemify-tree.scm ;; ;; Converts directory tree into assoc dictionary. ;; ;; ISC License ;; ;; Copyright 2025 Brmlab, z.s. ;; Dominik Pantůček ;; ;; Permission to use, copy, modify, and/or distribute this software ;; for any purpose with or without fee is hereby granted, provided ;; that the above copyright notice and this permission notice appear ;; in all copies. ;; ;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL ;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED ;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE ;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR ;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS ;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, ;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN ;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ;; (import (chicken process-context) (chicken file) (chicken pathname) (chicken format) (chicken io)) (define (get-argv) (let* ((args (argv)) (rargs (member "--" args))) (if rargs (cdr rargs) (if (equal? (car args) "csi") '() (cdr args))))) (define args0 (get-argv)) (define args (if (null? args0) '("../frontend/dist" "frontend" "frontend-lookup") args0)) (when (< (length args) 1) (display "usage: schemify-tree dir") (newline) (exit 1)) (define dir (car args)) (define modname (if (null? (cdr args)) 'frontend-data (string->symbol (cadr args)))) (define lookupname (if (or (null? (cdr args)) (null? (cddr args))) 'frontend-lookup (string->symbol (caddr args)))) (define (scan-dir-tree dir . cs) (let ((col (if (null? cs) '() (car cs))) (filenames (directory dir))) (let loop ((filenames filenames) (col col)) (if (null? filenames) col (let* ((filename (car filenames)) (fpath (make-pathname dir filename))) (if (directory-exists? fpath) (loop (cdr filenames) (scan-dir-tree fpath col)) (loop (cdr filenames) (cons fpath col)))))))) (define (load-dir-tree dir tree) (let ((dir-len (string-length dir))) (let loop ((tree tree) (alst '())) (if (null? tree) alst (let* ((fpath (car tree)) (key0 (substring fpath dir-len)) (key (if (eq? (string-ref key0 0) #\/) (substring key0 1) key0)) (value (with-input-from-file fpath read-string))) (loop (cdr tree) (cons (cons key value) alst))))))) (define (make-tree-module dir name getter) (let* ((tree (scan-dir-tree dir)) (alst (load-dir-tree dir tree))) `(module ,name (,getter) (import scheme srfi-4 (chicken base)) (define alst ',alst) (define (,getter key . vs) (let ((klst (assoc key alst))) (if klst (cdr klst) (if (null? vs) (error ,getter "key not found" key) (car vs)))))))) (define (compile-tree-module dir name getter) (with-output-to-file (format "~a.scm" name) (lambda () (display `(declare (unit ,name))) (newline) (write (make-tree-module dir name getter)) (newline)))) (compile-tree-module dir modname lookupname)