commit 3238d793fde0cb02cfae91c005b57751760dd07c
Author: retropikzel <retropikzel@iki.fi>
Date:   Sat Sep 6 08:42:39 2025 +0300

    Add dependencies without cond-expand to list

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..9f9218a
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+*.swp
+*.swo
+git-to-snow-repo
diff --git a/Dockerfile b/Dockerfile
new file mode 100644
index 0000000..8fe85b8
--- /dev/null
+++ b/Dockerfile
@@ -0,0 +1,36 @@
+FROM debian:trixie
+RUN apt-get update && apt-get install -y \
+    build-essential \
+    make \
+    git \
+    ca-certificates \
+    chicken-bin \
+    pandoc \
+    libffi-dev \
+    tree \
+    file
+RUN chicken-install r7rs
+RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1
+WORKDIR /chibi-scheme
+RUN make
+RUN make install
+WORKDIR /build
+RUN mkdir -p /usr/local/bin
+RUN ls
+COPY --from=retropikzel1/compile-r7rs /opt/compile-r7rs /opt/compile-r7rs
+ENV PATH=/opt/compile-r7rs/bin:${PATH}
+ARG SCHEME=chibi
+ENV COMPILE_R7RS=${SCHEME}
+RUN mkdir -p ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm
+RUN snow-chibi --impls=${SCHEME} --always-yes install "(foreign c)"
+RUN git clone https://git.sr.ht/~retropikzel/foreign-c-system --depth=1
+RUN cd foreign-c-system && make SCHEME=${SCHEME} && make SCHEME=${SCHEME} force-install
+#RUN snow-chibi --impls=${SCHEME} --always-yes install "(retropikzel system)"
+RUN snow-chibi --impls=${SCHEME} --always-yes install "(srfi 170)"
+RUN git clone https://git.sr.ht/~retropikzel/foreign-c-srfi-170 --depth=2
+RUN cd foreign-c-srfi-170 && make SCHEME=${SCHEME} && make SCHEME=${SCHEME} force-install
+COPY Makefile .
+COPY git-to-snow-repo.scm .
+RUN make SCHEME=${SCHEME}
+RUN make PREFIX=/opt/git-to-snow-repo install
+ENV PATH=/opt/git-to-snow-repo/bin:${PATH}
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..726637b
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,23 @@
+PREFIX=/usr/local
+SCHEME=chibi
+COMPILE_R7RS=${SCHEME}
+
+all: build
+
+build:
+	compile-r7rs -o git-to-snow-repo git-to-snow-repo.scm
+
+install:
+	mkdir -p ${PREFIX}/bin
+	install git-to-snow-repo ${PREFIX}/bin/git-to-snow-repo
+
+test-docker:
+	docker build -f Dockerfile --tag=git-to-snow-repo-test .
+	docker run -v "${PWD}":/workdir -w /workdir -t git-to-snow-repo-test sh -c "git-to-snow-repo example-list.scm"
+
+clean:
+	rm -rf git-to-snow-repo
+
+clean-all: clean
+	rm -rf deps
+
diff --git a/example-list.scm b/example-list.scm
new file mode 100644
index 0000000..1288a36
--- /dev/null
+++ b/example-list.scm
@@ -0,0 +1,10 @@
+(((description "Small \"Hello world\" library to be used with testing of snow-fort")
+  (url "https://git.sr.ht/~retropikzel/scheme-hello-world")
+  (library (path "retropikzel/hello.sld"))
+  (library (path "retropikzel/hello/util.sld")))
+ ((description "C Foreign Function Interface (FFI) library for R7RS Schemes")
+  (maintainers "Retropikzel") ; Optional, if left out will be looked from git url
+  (url "https://git.sr.ht/~retropikzel/foreign-c")
+  (library (path "foreign/c.sld")
+           (foreign-depends "ffi") ; Not optional if there is a dependency
+           )))
diff --git a/git-to-snow-repo.scm b/git-to-snow-repo.scm
new file mode 100644
index 0000000..fbe5146
--- /dev/null
+++ b/git-to-snow-repo.scm
@@ -0,0 +1,170 @@
+(import (scheme base)
+        (scheme read)
+        (scheme write)
+        (scheme file)
+        (scheme process-context)
+        (retropikzel system)
+        (srfi 1)
+        (srfi 170))
+
+(when (< (length (command-line)) 2)
+  (error "Pass the git repository list as first argument" (command-line)))
+
+(define data
+  (with-input-from-file (list-ref (command-line) 1) (lambda () (read))))
+
+(define (get ls check key)
+  (when (not (assq key ls))
+    (error (string-append "Could not find key: "
+                          (symbol->string key)
+                          " from data.")
+           ls))
+  (let ((value (car (cdr (assq key ls)))))
+    (when (not (apply check (list value)))
+      (error "Check failed on field value."
+             `((lib ,ls)
+               (check ,check)
+               (value ,value))))
+    value))
+
+(define (rmdir-r path)
+  (if (not (file-info-directory? (file-info path #f)))
+    (delete-file path)
+    (let ((files (map (lambda (p)
+                        (string-append path "/" p))
+                      (directory-files path #t))))
+      (cond ((null? files) (delete-directory path))
+            (else (for-each rmdir-r (map real-path files))
+                  (delete-directory path))))))
+
+(define (shell->list command)
+  (call-with-temporary-filename
+    (lambda (file)
+      (system (string-append command " > " file))
+      (letrec* ((looper (lambda (result line)
+                          (if (eof-object? line)
+                            result
+                            (looper (append result (list line)) (read-line))))))
+        (with-input-from-file
+          file
+          (lambda ()
+            (looper (list) (read-line))))))))
+
+(define (get-created dir tag)
+  (let ((time (shell->list
+                (apply string-append
+                       `("git -C "
+                         ,dir
+                         " log -1 --format=%ai "
+                         ,tag
+                         " | tr ' ' '\n'")))))
+    (string-append (list-ref time 0) "T" (list-ref time 1) (list-ref time 2))))
+
+(define (collect ls key)
+  (let ((result (list)))
+    (for-each
+      (lambda (item)
+        (when (eq? (car item) key)
+          (set! result (append result (list item)))))
+      ls)
+    result))
+
+(define (get-libraries dir lib)
+  (let ((result (list)))
+    (for-each
+      (lambda (item)
+        (when (equal? (car item) 'library)
+
+          (when (not (assq 'path (cdr item)))
+            (error "Library with no path" lib))
+
+          (when (not (string? (car (cdr (assq 'path (cdr item))))))
+            (error "Library with non string path" lib))
+
+          (let* ((file (car (cdr (assq 'path (cdr item)))))
+                 (path (string-append dir "/" file)))
+            (if (not (file-exists? path))
+              (begin
+                (display "WARNING: Library with non existing path ignored")
+                (newline)
+                (display "  ")
+                (write item)
+                (newline))
+              (let* ((data (with-input-from-file path (lambda () (read))))
+                     (foreign-depends (if (assq 'foreign-depends (cdr item))
+                                        `((foreign-depends
+                                            ,(car (cdr (assq 'foreign-depends
+                                                             (cdr item))))))
+                                        '()))
+                     (debug
+                       (begin
+                         ;(display "HERE: ")
+                         ;(write (collect (cdr data) 'cond-expand))
+                         ;(newline)
+                         1
+
+                         ))
+                     (depends (map cdr (collect (cdr data) 'import))))
+                (set! result
+                  (append result
+                          (list (append `((name ,(list-ref data 1))
+                                          (path ,file))
+                                        foreign-depends
+                                        (if (null? depends)
+                                          '()
+                                          `((depends ,@(car depends))))
+                                        )))))))))
+      lib)
+    result))
+
+(display "(repository")
+(newline)
+(for-each
+  (lambda (lib)
+    (let ((description (get lib string? 'description))
+          (url (get lib string? 'url)))
+      (call-with-temporary-filename
+        (lambda (dir)
+          (let* ((git-command (apply string-append
+                                     `("git clone "
+                                       ,url
+                                       " "
+                                       ,dir
+                                       " 2> /tmp/null")))
+                 (git-output (system git-command))
+                 (files (map (lambda (i)
+                               (real-path (string-append dir "/" i)))
+                             (directory-files dir)))
+                 (tags (shell->list (apply string-append
+                                           `("git -C "
+                                             ,dir
+                                             " tag 2>&1 > "
+                                             ,(string-append dir "/tags"))))))
+            (for-each
+              (lambda (tag)
+                (let* ((hash (car (shell->list
+                                    (apply string-append
+                                           `("git -C "
+                                             ,dir
+                                             " rev-parse "
+                                             ,tag
+                                             " > "
+                                             ,(string-append dir "/hash"))))))
+                       (created (get-created dir tag))
+                       (updated (get-created dir tag))
+                       (libraries (get-libraries dir lib))
+                       (data `(package (git (url ,url)
+                                            (tag ,tag)
+                                            (hash ,hash))
+                                       (version ,tag)
+                                       (created ,created)
+                                       ,@libraries)))
+                  (display "  ")
+                  (write data)
+                  (newline)))
+              tags)
+          (rmdir-r dir))))))
+  data)
+(display ")")
+(newline)
+