Check-in [1eaafa95a1]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:added redis
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:1eaafa95a1cf9dc9b70f643dae677096c92544df
User & Date: aldo 2018-12-09 15:21:26
Context
2018-12-09
15:23
added keyword and optional syntax for lambda and define check-in: 2b9e9a2608 user: aldo tags: trunk
15:21
added redis check-in: 1eaafa95a1 user: aldo tags: trunk
15:20
changed cairo-pdf-surface-create-for-stream closure parameter to ptr check-in: a7e9ec9d65 user: aldo tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added redis.sls.



































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#| Created and Maintained by Jack Lucas <silverbeard@protonmail.com>
see standalone repo at https://github.com/silverbeard00/siredis for license
|#

(library
    (redis)
  (export return-redis-closure redis-init)

  (import (chezscheme)
          (only (srfi s1 lists) take drop first)
          (posix)
          (socket))

  (include "redis/main.scm")

  (define (redis-init)
    (load-shared-object "libc.so.6")))

Added redis/main.scm.











































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#| Created and Maintained by Jack Lucas <silverbeard@protonmail.com>
see standalone repo at https://github.com/silverbeard00/siredis for license
|#

(define-record-type redsock
  (fields name ip port send (mutable receive)))

(define (red-mk-socket addr port)
  (let ((s (socket 'inet 'stream '() 0)))
    (connect/inet s addr port)
    (make-redsock "Redis" addr port s 0)))

(define (red-snd redsock command)
  (let ((active-sock (redsock-send redsock)))
    (put-bytevector
     active-sock
     (string->utf8 (format #f "~a\r\n" command)))
    (flush-output-port active-sock)))

(define (red-recv redsock)
  (red-read-socket redsock))

(define (red-byte-convert sock)
  (utf8->string (bytevector (get-u8 sock))))

(define (red-clear-end-tags sock)
  (get-u8 sock) (get-u8 sock))

(define (red-read-integer sock)
  (string->number (red-read-socket sock)))

;;;Should be turned into a vector version that converts to
;;;a string at the last step.
(define (red-read-socket sock)
  (let ((redsock (redsock-send sock)))
    (let getter ((data
                  (red-byte-convert redsock))
                 (acc "") (prev 0))
      (cond
       ((and (equal? acc "") (equal? data "*"))
        (red-read-array sock))
       ((and (equal? acc "") (equal? data ":"))
        (red-read-integer sock))
       ((and (equal? acc "") (equal? data "$"))
        (let ((l (red-byte-convert redsock)))
          (if (and (equal? l "-")
                   (equal? (red-byte-convert redsock) "1"))
              (begin
                (red-clear-end-tags redsock)
                #f)
              (begin
                (red-clear-end-tags redsock)
                (red-read-socket sock)))))

       ((equal? data "\r")
        (let ((l (red-byte-convert redsock)))
          (if (equal? l "\n")
              acc
              (getter l
                      (string-append acc data)
                      data))))
       (else
        (getter (red-byte-convert redsock)
                (string-append acc data)
                data))))))

(define (red-array-length redsock)
  (let ((data (string->list (red-read-socket redsock))))
    (string->number (list->string data))))

(define (red-read-array redsock)
  (let ((active-sock (redsock-send redsock))
        (num (red-array-length redsock)))
    (if (= num -1)
        #f
        (let array-read ((num num)
                         (acc '()))
          (cond
           ((= num 0) (reverse acc))
           (else
            (let ((data (red-read-socket redsock)))
              (array-read (- num 1) (cons data acc)))))))))

(define (red-parse-command cmd)
  (fold-left (lambda (x y)
               (cond
                ((symbol? y)
                 (string-append x " " (symbol->string y)))
                ((number? y)
                 (string-append x " " (number->string y)))
                ((string? y)
                 (string-append x " " y))))
             (symbol->string (car cmd))
             (cdr cmd)))

(define (red-parse-commands cmds)
  (map (lambda (x)  (red-parse-command x))
       cmds))

(define (red-pipe-recv sock cmd)
  (map (lambda (cmd0) (red-recv sock))
       cmd))

(define (red-operate sock cmd)
  (if (and (pair? (first cmd)) (list? (first cmd)))
      (begin
        (map (lambda (cmd0) (red-snd sock cmd0))
             (red-parse-commands cmd))
        (red-pipe-recv sock cmd))
      (begin
        (red-snd sock (red-parse-command cmd))
        (red-recv sock))))

(define (return-redis-closure ip port)
  (let ((internal-socket (red-mk-socket ip port)))
    (lambda cmd
      (red-operate internal-socket cmd))))


#|Examples of creating shorthand for redis commands|#

(define (red-set key value)
  `(set ,key ,value))

(define (red-get key)
  `(get ,key))

(define (red-append key value)
  `(append ,key ,value))

(define (red-getset key value)
  `(get-set ,key ,value))