Fix task action handling

Refactor actions to remove context
This commit is contained in:
Ray Miller 2025-01-06 21:38:32 +00:00
parent f2f88ce0dc
commit b463a828be
Signed by: ray
GPG key ID: 043F786C4CD681B8
3 changed files with 8 additions and 8 deletions

View file

@ -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)))

View file

@ -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

View file

@ -38,4 +38,4 @@
(fritz . ,(handler "Fritz" (const #t)))
(frotz . ,(handler "Frotz" (const #t))))))
;;(run-play test-play)
(run-play test-play)