~evhan/beaker

ref: a613b5f78c7521d010b5089805edf0e2d59ae3cf beaker/lib/beaker/egg/info.scm -rw-r--r-- 1.8 KiB
a613b5f7Evan Hanson Avoid false-positive module reference warnings when compiler syntax is applied 3 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Helper procedures for working with egg files.
;;;
;;; Copyright (c) 2018-2019, Evan Hanson
;;;
;;; See LICENSE for details.
;;;

(declare
  (module (beaker egg info))
  (export egg-author
          egg-dependencies
          egg-extensions
          egg-import-libraries
          egg-name
          egg-programs)
  (import (chicken condition)
          (chicken pathname)
          (srfi 1)))

(define (egg-name egg-file)
  (string->symbol (pathname-file egg-file)))

(define (egg-info-slot egg-info name)
  (alist-ref name egg-info eq? '()))

(define (read-egg-info egg-file)
  (handle-exceptions _ '() (with-input-from-file egg-file read)))

(define (egg-dependencies egg-file)
  (map (lambda (d) (if (pair? d) (car d) d))
       (egg-info-slot (read-egg-info egg-file) 'dependencies)))

(define (egg-author egg-file)
  (let ((author (egg-info-slot (read-egg-info egg-file) 'author)))
    (and (pair? author) (car author))))

(define (egg-components egg-file #!optional type)
  (let ((egg-info (read-egg-info egg-file)))
    (filter-map (lambda (c)
                  (and (pair? c)
                       (pair? (cdr c))
                       (symbol? (cadr c))
                       (or (not type)
                           (eq? (car c) type))
                       (cdr c)))
                (egg-info-slot egg-info 'components))))

(define (egg-extensions egg-file)
  (map car (egg-components egg-file 'extension)))

(define (egg-import-libraries egg-file)
  (append-map (lambda (x)
                 (or (alist-ref 'modules (cdr x))
                     (list (car x))))
              (egg-components egg-file 'extension)))

(define (egg-programs egg-file)
  (map car (egg-components egg-file 'program)))