Test vars and overrides
This commit is contained in:
parent
12c45b628c
commit
af16ee29b6
3 changed files with 15 additions and 19 deletions
|
@ -19,6 +19,7 @@
|
||||||
|
|
||||||
(define* (install-directory path #:key owner group mode)
|
(define* (install-directory path #:key owner group mode)
|
||||||
(lambda (conn)
|
(lambda (conn)
|
||||||
|
(format #t "install-directory ~a~%" path)
|
||||||
(connection-must conn "install" (chain-when
|
(connection-must conn "install" (chain-when
|
||||||
'("--directory")
|
'("--directory")
|
||||||
(owner (append _ `("--owner" ,owner)))
|
(owner (append _ `("--owner" ,owner)))
|
||||||
|
@ -45,6 +46,7 @@
|
||||||
(when (not (= 1 (length (filter identity (list content local-src remote-src)))))
|
(when (not (= 1 (length (filter identity (list content local-src remote-src)))))
|
||||||
(error "exactly one of #:content, #:local-src, or #:remote-src is required"))
|
(error "exactly one of #:content, #:local-src, or #:remote-src is required"))
|
||||||
(lambda (conn)
|
(lambda (conn)
|
||||||
|
(format #t "install-file ~a~%" path)
|
||||||
(let ((remote-src (cond
|
(let ((remote-src (cond
|
||||||
(remote-src remote-src)
|
(remote-src remote-src)
|
||||||
(local-src (call-with-input-file local-src (upload-tmp-file conn)))
|
(local-src (call-with-input-file local-src (upload-tmp-file conn)))
|
||||||
|
|
|
@ -21,6 +21,7 @@
|
||||||
(define* (context #:key scratch-dir init-vars)
|
(define* (context #:key scratch-dir init-vars)
|
||||||
(make-context scratch-dir init-vars))
|
(make-context scratch-dir init-vars))
|
||||||
|
|
||||||
|
;; TODO: (resolve-content-refs ctx (lambda (x) x)) fails
|
||||||
(define-syntax resolve-context-refs
|
(define-syntax resolve-context-refs
|
||||||
(syntax-rules ($)
|
(syntax-rules ($)
|
||||||
((_ ctx ($ x))
|
((_ ctx ($ x))
|
||||||
|
|
31
tryme.scm
31
tryme.scm
|
@ -1,38 +1,31 @@
|
||||||
(use-modules
|
(use-modules
|
||||||
|
(ice-9 filesystem)
|
||||||
(ordo connection)
|
(ordo connection)
|
||||||
(ordo action filesystem)
|
(ordo action filesystem)
|
||||||
(ordo play)
|
(ordo play)
|
||||||
(ordo task)
|
(ordo task)
|
||||||
(ordo handler))
|
(ordo handler))
|
||||||
|
|
||||||
;; TODO: Consider how vars might be used in task args Currently a task argument
|
|
||||||
;; can be a context refrence, for example we could write:
|
|
||||||
;;
|
|
||||||
;; (install-directory (context-ref 'base-dir))
|
|
||||||
;;
|
|
||||||
;; but there's no way to nest these, so we this will not work:
|
|
||||||
;;
|
|
||||||
;; (install-file (file-name-join (context-ref 'base-dir) "foo"))
|
|
||||||
;;
|
|
||||||
;; Maybe we could implement something like:
|
|
||||||
;;
|
|
||||||
;; (install-file (context-fn (file-name-join (context-ref 'base-dir) "foo")))
|
|
||||||
;;
|
|
||||||
;; where context-fn is some syntax that returns (lambda (ctx) ...)
|
|
||||||
|
|
||||||
(define test-play
|
(define test-play
|
||||||
(play "Test play"
|
(play "Test play"
|
||||||
#:connection (local-connection)
|
#:connection (local-connection)
|
||||||
|
#:vars '((base-dir . "/home/ray/ordo-test"))
|
||||||
#:tasks (list
|
#:tasks (list
|
||||||
|
(task "Override base dir"
|
||||||
|
(const "/home/ray/ordo-test-again")
|
||||||
|
#:register 'base-dir)
|
||||||
(task "Create test directory"
|
(task "Create test directory"
|
||||||
(install-directory "/home/ray/ordo-test"))
|
(install-directory ($ 'base-dir)))
|
||||||
(task "Create test file from string content"
|
(task "Create test file from string content"
|
||||||
(install-file "/home/ray/ordo-test/foo" #:content "Hello, world!\n"))
|
(install-file (file-name-join* ($ 'base-dir) "foo")
|
||||||
|
#:content "Hello, world!\n"))
|
||||||
(task "Create test file from local source"
|
(task "Create test file from local source"
|
||||||
(install-file "/home/ray/ordo-test/bar" #:local-src "/home/ray/ordo-test/foo")
|
(install-file (file-name-join* ($ 'base-dir) "bar")
|
||||||
|
#:local-src (file-name-join* ($ 'base-dir) "foo"))
|
||||||
#:triggers '(fritz))
|
#:triggers '(fritz))
|
||||||
(task "Create test file from remote source"
|
(task "Create test file from remote source"
|
||||||
(install-file "/home/ray/ordo-test/baz" #:remote-src "/home/ray/ordo-test/bar")
|
(install-file (file-name-join* ($ 'base-dir) "baz")
|
||||||
|
#:remote-src (file-name-join* ($ 'base-dir) "bar"))
|
||||||
#:triggers '(frobnicate)))
|
#:triggers '(frobnicate)))
|
||||||
#:handlers `((frobnicate . ,(handler "Frobnicate" (const #t)))
|
#:handlers `((frobnicate . ,(handler "Frobnicate" (const #t)))
|
||||||
(fritz . ,(handler "Fritz" (const #t)))
|
(fritz . ,(handler "Fritz" (const #t)))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue