Fix task action handling
Refactor actions to remove context
This commit is contained in:
parent
f2f88ce0dc
commit
b463a828be
3 changed files with 8 additions and 8 deletions
|
@ -5,7 +5,6 @@
|
|||
#:use-module (srfi srfi-71) ; extended let
|
||||
#:use-module ((srfi srfi-197) #:select (chain-when))
|
||||
#:use-module (ordo connection)
|
||||
#:use-module (ordo context)
|
||||
#:export (create-temporary-directory
|
||||
install-directory
|
||||
install-file))
|
||||
|
@ -30,7 +29,7 @@
|
|||
;; Helper not intended for use outside of this module
|
||||
(define (upload-tmp-file conn)
|
||||
(lambda (input-port)
|
||||
(let ((tmp-path (car (connection-must conn "mktemp"))))
|
||||
(let ((tmp-path (car (connection-must conn "mktemp" '()))))
|
||||
(connection-call-with-output-file conn tmp-path
|
||||
(lambda (output-port)
|
||||
(let loop ((data (get-bytevector-some input-port)))
|
||||
|
|
|
@ -28,15 +28,16 @@
|
|||
((_ description (action arg ...) kwarg ...)
|
||||
(task%
|
||||
description
|
||||
(lambda (conn ctx)
|
||||
(action conn (resolve-context-refs ctx arg) ...))
|
||||
(lambda (ctx)
|
||||
(action (resolve-context-refs ctx arg) ...))
|
||||
kwarg ...))))
|
||||
|
||||
(define (run-task conn ctx task)
|
||||
(match task
|
||||
(define (run-task conn ctx t)
|
||||
(match t
|
||||
(($ <task> description action register triggers)
|
||||
(format #t "RUNNING TASK ~a~%" description)
|
||||
(let ((result (action conn ctx)))
|
||||
(pk 'action action)
|
||||
(let ((result ((action ctx) conn)))
|
||||
(when register
|
||||
(register-context-var! ctx register result))
|
||||
(when triggers
|
||||
|
|
|
@ -38,4 +38,4 @@
|
|||
(fritz . ,(handler "Fritz" (const #t)))
|
||||
(frotz . ,(handler "Frotz" (const #t))))))
|
||||
|
||||
;;(run-play test-play)
|
||||
(run-play test-play)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue