about summary refs log tree commit diff stats
path: root/lib/util.scm
blob: f42878b2b76174cc437f607aa8f2c40aade3e7b5 (plain)
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
61
62
63
64
65
66
67
68
(module (jimmy util) *

  (import scheme (chicken base)
          (chicken condition)
          (chicken file)
          (chicken irregex)
          (chicken process-context)
          (chicken string)
          (srfi 1)
          utf8-srfi-13)

  (define-syntax define-public
    (syntax-rules ()
      ((define-public (name . arg) forms ...)
       (begin (export name)
              (define (name . arg) forms ...)))
      ((define-public (name args ...) forms ...)
       (begin (export name)
              (define (name args ...) forms ...)))
      ((define-public name value)
       (begin (export name)
              (define name value)))))

  (define-syntax ignore-errors
    (syntax-rules ()
      ((ignore-errors x)
       (handle-exceptions e #f x))))

  (define (alist-walk lis . keys)
    (if (null? keys)
        lis
        (let ((kv (assoc (car keys) lis)))
          (cond
           ((not kv) #f)
           ((atom? (cdr kv))
            (and (null? (cdr keys))       ; this shouldn't error...
                 (cdr kv)))
           ((list? (cdr kv))
            (apply alist-walk (cdr kv) (cdr keys)))))))

  (define (flush-lines-left lines)
    (irregex-replace/all '(: bol (* space))
                         (string-join lines) ""))

  (define (join-lines lines)
    (apply string-append lines))

  (define (find-command command . dirs)
    (define (find-command-in-dir dir)
      (and (directory-exists? dir)
           (find-files dir
                       limit: 0
                       test: `(: (* any) "/" ,command eos))))
    (define path+
      (append (string-split (get-environment-variable "PATH") ":") dirs))
    (define found
      (filter file-executable?
              (apply append (filter-map find-command-in-dir path+))))
    (if (pair? found) (car found) #f))

  (define (ensure-newline str)
    (if (string-suffix? "\n" str)
        str
        (string-append str "\n")))

  )