Add dependencies without cond-expand to list
This commit is contained in:
commit
3238d793fd
|
|
@ -0,0 +1,3 @@
|
|||
*.swp
|
||||
*.swo
|
||||
git-to-snow-repo
|
||||
|
|
@ -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}
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
)))
|
||||
|
|
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue