call from (eightsync agenda)

[8sync.git] / loopy.scm

diff --git a/loopy.scm b/loopy.scm
index 603a75a47e19afc1be2208530ce05b0d9a078a26..ca133b9f79d525825d31d6f90381fa0741683f83 100644 (file)
--- a/loopy.scm
+++ b/loopy.scm
@@ -1,4 +1,4 @@
-(define-module (loopy agenda)
+(define-module (eightsync agenda)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
@@ -33,11 +33,13 @@
             schedule-segments-split schedule-extract-until!
             add-segments-contents-to-queue!
 
+            %sync 8sync %sync-at 8sync-at %sync-delay 8sync-delay
+
             <run-request>
             make-run-request run-request?
             run-request-proc run-request-when
 
-            run-it wrap run run-at delay
+            run-it wrap run run-at run-delay
 
             %current-agenda
             start-agenda agenda-run-once))
@@ -77,6 +79,9 @@
   (time agenda-time))
 
 (define (make-async-prompt-tag)
+  "Make an async prompt tag for an agenda.
+
+Generally done automatically for the user through (make-agenda)."
   (make-prompt-tag "prompt"))
 
 (define* (make-agenda #:key
@@ -87,10 +92,21 @@
                       (except-port-map (make-hash-table))
                       (schedule (make-schedule))
                       (time (gettimeofday)))
+  ;; TODO: document arguments
+  "Make a fresh agenda."
   (make-agenda-intern queue prompt
                       read-port-map write-port-map except-port-map
                       schedule time))
 
+(define (current-agenda-prompt)
+  "Get the prompt for the current agenda; signal an error if there isn't one."
+  (let ((current-agenda (%current-agenda)))
+    (if (not current-agenda)
+        (throw
+         'no-current-agenda
+         "Can't get current agenda prompt if there's no current agenda!")
+        (agenda-prompt-tag current-agenda))))
+
 
 \f
 ;;; Schedule
@@ -326,6 +342,8 @@ Will produce (0 . 0) instead of a negative number, if needed."
   (lambda ()
     body ...))
 
+;; @@: Do we really want `body ...' here?
+;;   what about just `body'?
 (define-syntax-rule (run body ...)
   "Run everything in BODY but wrap in a convenient procedure"
   (make-run-request (wrap body ...) #f))
@@ -334,15 +352,84 @@ Will produce (0 . 0) instead of a negative number, if needed."
   "Run BODY at WHEN"
   (make-run-request (wrap body ...) when))
 
+;; @@: Is it okay to overload the term "delay" like this?
+;;   Would `run-in' be better?
 (define-syntax-rule (run-delay body ... delay-time)
   "Run BODY at DELAY-TIME time from now"
   (make-run-request (wrap body ...) (tdelta delay-time)))
 
-(define (delay run-request delay-time)
-  "Delay a RUN-REQUEST by DELAY-TIME"
-  (set-field run-request
-             (run-request-when)
-             (tdelta delay-time)))
+
+\f
+;;; Asynchronous escape to run things
+;;; =================================
+
+;; The future's in futures
+
+(define (make-future call-first on-success on-fail on-error)
+  ;; TODO: add error stuff here
+  (lambda ()
+    (let ((call-result (call-first)))
+      ;; queue up calling the 
+      (run (on-success call-result)))))
+
+(define (agenda-on-error agenda)
+  (const #f))
+
+(define (agenda-on-fail agenda)
+  (const #f))
+
+(define* (request-future call-first on-success
+                         #:key
+                         (agenda (%current-agenda))
+                         (on-fail (agenda-on-fail agenda))
+                         (on-error (agenda-on-error agenda))  
+                         (when #f))
+  ;; TODO: error handling
+  ;; do we need some distinction between expected, catchable errors,
+  ;; and unexpected, uncatchable ones?  Probably...?
+  (make-run-request
+   (make-future call-first on-success on-fail on-error)
+   when))
+
+(define-syntax-rule (%sync body args ...)
+  "Run BODY asynchronously at a prompt, passing args to make-future.
+
+Pronounced `async' despite the spelling.
+
+%sync was chosen because (async) was already taken and could lead to
+errors, and this version of asynchronous code uses a prompt, so the `a'
+character becomes a `%' prompt! :)
+
+The % and 8 characters kind of look similar... hence this library's
+name!  (There are 8sync aliases if you prefer that name.)"
+  (abort-to-prompt (current-agenda-prompt)
+                   (wrap body)
+                   args ...))
+
+(define-syntax-rule (%sync-at body when args ...)
+  (abort-to-prompt (current-agenda-prompt)
+                   (wrap body)
+                   #:when when
+                   args ...))
+
+(define-syntax-rule (%sync-delay body delay-time args ...)
+  (abort-to-prompt (current-agenda-prompt)
+                   (wrap body)
+                   #:when (tdelta delay-time)
+                   args ...))
+
+(define-syntax-rule (8sync args ...)
+  "Alias for %sync"
+  (%sync args ...))
+
+(define-syntax-rule (8sync-at args ...)
+  "Alias for %sync-at"
+  (%sync-at args ...))
+
+(define-syntax-rule (8sync-delay args ...)
+  "Alias for %sync-delay"
+  (8sync-delay args ...))
+
 
 \f
 ;;; Execution of agenda, and current agenda
@@ -351,6 +438,7 @@ Will produce (0 . 0) instead of a negative number, if needed."
 (define %current-agenda (make-parameter #f))
 
 (define (update-agenda-from-select! agenda)
+  "Potentially (select) on ports specified in agenda, adding items to queue"
   (define (hash-keys hash)
     (hash-map->list (lambda (k v) k) hash))
   (define (get-wait-time)
@@ -429,6 +517,8 @@ Will produce (0 . 0) instead of a negative number, if needed."
                        #:key stop-condition
                        (get-time gettimeofday)
                        (handle-ports update-agenda-from-select!))
+  ;; TODO: Document fields
+  "Start up the AGENDA"
   (let loop ((agenda agenda))
     (let ((agenda   
            ;; @@: Hm, maybe here would be a great place to handle
@@ -463,8 +553,9 @@ based on the results"
         (agenda-prompt-tag agenda)
       (lambda ()
         (proc))
-      ;; TODO
-      (lambda (k) k)))
+      (lambda* (resume-with please-run-this . args)
+        (apply request-future please-run-this resume-with
+               args))))
 
   (let ((queue (agenda-queue agenda))
         (next-queue (make-q)))