syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Allow garbage-collection of no-longer-needed operations.

This commit is contained in:
Tony Garnock-Jones 2016-07-25 20:41:49 -04:00
parent d67d490885
commit eb27d6acc5
1 changed files with 19 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
examples/operational-transformation/syndicate-server.rkt
View File

@ -11,6 +11,7 @@
(struct file-being-edited (name) #:prefab)
(struct proposed-op (p) #:prefab)
(struct accepted-op (p) #:prefab)
(struct client-seen-up-to (revision) #:prefab)
(define cmdline-port (make-parameter 5888))
(define cmdline-filename (make-parameter "info.rkt"))
@ -23,6 +24,17 @@
""))))])
(assert (extract-snapshot (state)))
(define/query-set client-seen-revs (client-seen-up-to $rev) rev)
(let ((oldest-needed-rev #f))
(begin/dataflow
(define min-rev
(or (for/fold [(min-rev #f)] [(rev (client-seen-revs))]
(min (or min-rev rev) rev))
(server-state-revision (state))))
(when (not (equal? oldest-needed-rev min-rev))
(set! oldest-needed-rev min-rev)
(state (forget-operation-history (state) oldest-needed-rev)))))
(begin/dataflow
(display-to-file (simple-document-text (server-state-document (state)))
(cmdline-filename)
@ -50,15 +62,21 @@
(newline p)
(send! (tcp-channel s c (get-output-bytes p))))
(field [seen-up-to 0])
(assert (client-seen-up-to (seen-up-to)))
(on-start
(output filename)
(let-event [(asserted ($ snapshot (server-snapshot _ _)))]
(output snapshot)
(seen-up-to (server-snapshot-revision snapshot))
(react (on (message (accepted-op $p))
(output p)))))
(on (message (tcp-channel-line c s $line))
(send! (proposed-op (deserialize (read (open-input-bytes line)))))))
(match (deserialize (read (open-input-bytes line)))
[(? number? n) (seen-up-to n)]
[(? pending-operation? p) (send! (proposed-op p))])))
(module+ main
(require racket/cmdline)