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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216

(define-module (utils)
  #:use-module (rnrs bytevectors)
  #:use-module (ice-9 binary-ports)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-1)
  #:export (assoc-value
            safe-car
            safe-cdr
            find-compute
            bytevector-null?
            bytevector->hex-string
            bytevector-from-file
            file-extension
            string-substitute
            error-message?
            make-error-message
            error-message-text
            map-n-times
            do-n-times
            read-sexp
            string-match1
            string->number-safe
            escape-host
            get-file-contents
            multi-value-or
            sxml->xml-bv
            read-file
            write-file
            pick-random
            vector-pick-random
            check-fail

            notice-id-num
            notice-id-str))

(define (error-message? x) (and (list? x) (equal? 'error-message (car x))))
(define (make-error-message message) (list 'error-message message))
(define error-message-text cadr)

(define (bytevector-null? bv) (eqv? 0 (bytevector-length bv)))

(define (bytevector->hex-string bv)
  (define port (open-bytevector-input-port bv))
  (set-port-encoding! port "UTF-8")
  (call-with-output-string
   (lambda (out-port)
     (define (loop)
       (define byte (get-u8 port))
       (if (eof-object? byte)
           'end
           (begin
             (if (< byte 16)
                 (format out-port "0~x" byte)
                 (format out-port "~x" byte))
             (loop))))
     (loop))))

(define (bytevector-from-file file-path)
  (call-with-input-file file-path
    (lambda (port)
      (define bv (get-bytevector-all port))
      (if (eof-object? bv)
          #f
          bv))))

(define (file-extension str)
  "for file.png it returns png
   for file.tar.gz it returns gz"
  (define match (string-match "\\.([^\\.]+)$" str))
  (if match
      (match:substring match 1)
      #f))

(define* (assoc-value key alist #:optional (alternative #f))
  (define result (assoc key alist))
  (if result (cdr result) alternative))

(define (safe-car lst) (if (not (null? lst)) (car lst) #f))
(define (safe-cdr lst) (if (not (null? lst)) (cdr lst) '()))

(define (find-compute test-proc lst)
  "Like find, but it returns the value from test-proc instead of the list item"
  (define (itr current rest)
    (define result (test-proc current))
    (if result
        result
        (if (null? rest)
            #f
            (itr (car rest) (cdr rest)))))
  (if (null? lst)
      #f
      (itr (car lst) (cdr lst))))

(define* (string-substitute search substitute recursive? str #:optional (start-pos 0))
  (define found (string-contains str search start-pos))
  (define result
    (if found
        (cons #t (string-replace str
                                 substitute
                                 found (+ found (string-length search))))
        (cons #f str)))
  ;; (warn "string-substitute" str result)
  (if (and (car result) recursive?)
      (string-substitute search substitute recursive? (cdr result)
                         (+ found
                            (string-length substitute)))
      (cdr result)))

(define (do-n-times fn n)
  (do ((i 0 (+ 1 i)))
      ((> i n))
    (fn i)))

(define (map-n-times fn n)
  (define acc '())
  (do ((i 0 (+ 1 i)))
      ((>= i n))
    (set! acc (cons (fn i) acc)))
  acc)


(define (read-sexp string)
  (call-with-input-string string (lambda (port) (read port))))

(define (get-file-contents file-path)
  ;; TODO use (ice-9 textual-ports) with guile2.2
  (define (read-step)
    (let ((c (read-char)))
      (if (eof-object? c)
          (current-output-port)
          (begin
            (display c)
            (read-step)))))
  (with-input-from-file file-path
    (lambda ()
      (with-output-to-string
        (lambda ()
          (set-port-encoding! (current-output-port) "utf-8")
          (read-step))))))

(define (string-match1 regex string)
  (define match (string-match regex string))
  (if match
      (match:substring match 1)
      #f))
(define (string->number-safe str)
  (and (string? str) str))

;;; take a list of names for multiple values
;;; and n multiple value expressions
;;; and return the first one where none of the values is #f
(define-syntax multi-value-or
  (syntax-rules ()
    ((_ (value-names ...) expression)
     (call-with-values (lambda () expression)
       (lambda (value-names ...)
         (if (and value-names ...)
             (values value-names ...)
             #f))))
    ((_ (value-names ...) expression rest ...)
     (call-with-values (lambda () expression)
       (lambda (value-names ...)
         (if (and value-names ...)
             (values value-names ...)
             (multi-value-or (value-names ...) rest ...)))))))

(define (escape-host host-str)
  ;; TODO FIXME SECURITY
  "make sure that localhost or internal ips aren't called"
  host-str)

(define (secure-external-url url)
  ;; TODO FIXME SECURITY
  "make sure that localhost or internal ips aren't called"
  url)

(define* (sxml->xml-bv sxml sxml->xml #:optional (add-header #f))
  (call-with-values (lambda () (open-bytevector-output-port))
    (lambda (out-port finalize-output-bytevector)
      (set-port-encoding! out-port "UTF-8")
      (when add-header
        (display "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" out-port))
      (sxml->xml sxml out-port)
      (finalize-output-bytevector))))

(define (pick-random lst)
  (define len (length lst))
  (list-ref lst (random len)))

(define (vector-pick-random v)
  (define len (vector-length v))
  (vector-ref v (random len)))

(define (read-file file)
  (and (file-exists? file)
       (call-with-input-file file
         (lambda (port) (read port)))))

(define (write-file file data)
  (call-with-output-file file
    (lambda (port) (write data port))))

(define (notice-id-str notice)
  (define id (assoc-ref notice 'id))
  (if (number? id)
      (number->string id)
      id))

(define (notice-id-num notice)
  (define id (assoc-ref notice 'id))
  (if (number? id)
      id
      (string->number id)))

(define (check-fail message value)
  (if value #f message))