From 8a1e1b244fb3ed0c9136f3c83863ce4ab3282c8b Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Thu, 23 Jan 2025 18:19:54 +0000 Subject: [PATCH] Some simplifications --- examples/basic.scm | 34 ++++++++++++++++++++++++++++++ examples/install-aws-cli.scm | 19 +++++++++++------ modules/ordo/action/filesystem.scm | 16 ++++++++------ modules/ordo/cli.scm | 4 ++++ modules/ordo/connection.scm | 1 + modules/ordo/play.scm | 7 +++--- modules/ordo/playbook.scm | 3 ++- modules/ordo/task.scm | 21 +++++++++++------- 8 files changed, 78 insertions(+), 27 deletions(-) create mode 100644 examples/basic.scm diff --git a/examples/basic.scm b/examples/basic.scm new file mode 100644 index 0000000..597d1ad --- /dev/null +++ b/examples/basic.scm @@ -0,0 +1,34 @@ +(use-modules + (ice-9 filesystem) + (ice-9 pretty-print) + (logging logger) + (ordo) + (ordo action filesystem)) + +(playbook + #:name "Basic filesystem operations" + #:plays (list + (play + #:name "Temporary files on localhost" + #:host "localhost" + #:tasks (list + (task #:name "Create temporary directory" + #:action (lambda () (fs:create-tmp-dir (current-connection))) + #:register-play-var #:tmp-dir) + + (task #:name "Create hello.txt" + #:action (lambda () (fs:install-file (current-connection) + (file-name-join* ($ #:tmp-dir) "hello.txt") + #:content "Hello, world!")) + #:register-play-var #:hello) + + (task #:name "Stat hello.txt" + #:action (lambda () (fs:stat (current-connection) ($ #:hello))) + #:register-play-var #:hello-stat) + + (task #:name "Debug variables" + #:action (lambda () + (pretty-print (list #:hello ($ #:hello) #:hello-stat ($ #:hello-stat))))) + + (task #:name "Clean up tmp dir" + #:action (lambda () (fs:remove (current-connection) ($ #:tmp-dir) #:recurse? #t #:verbose? #t))))))) diff --git a/examples/install-aws-cli.scm b/examples/install-aws-cli.scm index 15ea839..0ee79aa 100644 --- a/examples/install-aws-cli.scm +++ b/examples/install-aws-cli.scm @@ -19,10 +19,15 @@ (lambda () (run conn "rm" "-rf" tmp-dir))))) -(playbook "Test Playbook" - (play "Test play" - #:host "localhost" - (task - (install-aws-cli #:update? #t - #:install-dir (file-name-join* ($ #:fact.home-dir) ".local" "aws-cli") - #:bin-dir (file-name-join* ($ #:fact.home-dir) ".local" "bin"))))) +(playbook + #:name "Test Playbook" + #:plays (list + (play + #:name "Test play" + #:host "localhost" + #:tasks (list + (task #:name "Install AWS CLI" + #:action (lambda () + (install-aws-cli #:update? #t + #:install-dir (file-name-join* ($ #:fact.home-dir) ".local" "aws-cli") + #:bin-dir (file-name-join* ($ #:fact.home-dir) ".local" "bin")))))))) diff --git a/modules/ordo/action/filesystem.scm b/modules/ordo/action/filesystem.scm index 2a56409..7bd0bf4 100644 --- a/modules/ordo/action/filesystem.scm +++ b/modules/ordo/action/filesystem.scm @@ -36,13 +36,15 @@ ((string-contains (first result) "No such file or directory") #f) (else (error (format #f "stat ~a: ~a" path (first result))))))) -(define* (fs:remove conn path #:key (recurse? #f) (force? #f) (verbose? #t)) - (run conn "rm" (chain-when '() - (verbose? (append _ '("-v"))) - (recurse? (append _ '("-r"))) - (force? (append _ '("-f"))) - (#t (append _ `(,path)))) - #:check? #t)) +(define* (fs:remove conn path #:key (recurse? #f) (force? #f) (verbose? #f)) + (let ((out (run conn "rm" (chain-when '() + (verbose? (append _ '("-v"))) + (recurse? (append _ '("-r"))) + (force? (append _ '("-f"))) + (#t (append _ `(,path)))) + #:check? #t))) + (when verbose? + (for-each (cut log-msg 'INFO <>) out)))) (define* (fs:link conn target link-name #:key (symbolic? #f) (force? #f) (backup? #f)) "Create a link to @code{target} with the name @code{link-name}." diff --git a/modules/ordo/cli.scm b/modules/ordo/cli.scm index 519e3f1..8312ccb 100644 --- a/modules/ordo/cli.scm +++ b/modules/ordo/cli.scm @@ -1,5 +1,6 @@ (define-module (ordo cli) #:use-module (ice-9 match) + #:use-module (logging logger) #:use-module (ordo logger) #:use-module (ordo context) #:use-module (ordo playbook) @@ -9,8 +10,11 @@ (define (main args) (match-let (((_ inventory-path playbook-path) args)) (setup-logging #:level 'DEBUG) + (log-msg 'DEBUG "Initializing context") (init-context!) (load inventory-path) + (log-msg 'DEBUG "Loaded inventory: " inventory-path) (let ((playbook (load playbook-path))) + (log-msg 'DEBUG "Loaded playbook: " playbook-path) (run-playbook playbook)) (quit))) diff --git a/modules/ordo/connection.scm b/modules/ordo/connection.scm index d5e3223..817f797 100644 --- a/modules/ordo/connection.scm +++ b/modules/ordo/connection.scm @@ -4,6 +4,7 @@ #:use-module (ice-9 match) #:use-module (logging logger) #:use-module (srfi srfi-1) ; list operations + #:use-module (srfi srfi-26) ; cut #:use-module (srfi srfi-71) ; extended let #:use-module (ordo connection base) #:use-module (ordo connection local) diff --git a/modules/ordo/play.scm b/modules/ordo/play.scm index 8586425..7c1f3a4 100644 --- a/modules/ordo/play.scm +++ b/modules/ordo/play.scm @@ -34,10 +34,9 @@ (handlers play-handlers) (gather-facts play-gather-facts)) -(define* (play name #:key host (sudo? #f) (sudo-user #f) (sudo-password #f) (vars '()) (gather-facts #t) . more) - (let ((tasks (filter task? more)) - (handlers (filter handler? more))) - (make-play name host sudo? sudo-user sudo-password vars gather-facts tasks handlers))) +;; TODO: argument validation +(define* (play #:key name host (sudo? #f) (sudo-user #f) (sudo-password #f) (vars '()) (gather-facts #t) tasks (handlers '())) + (make-play name host sudo? sudo-user sudo-password vars gather-facts tasks handlers)) (define (run-play p) (log-msg 'NOTICE "Running play: " (play-name p)) diff --git a/modules/ordo/playbook.scm b/modules/ordo/playbook.scm index b8a1169..a9df40d 100644 --- a/modules/ordo/playbook.scm +++ b/modules/ordo/playbook.scm @@ -17,7 +17,8 @@ (vars playbook-vars) (plays playbook-plays)) -(define* (playbook name #:key (vars '()) . plays) +;; TODO: argument validation +(define* (playbook #:key name (vars '()) plays) (make-playbook name vars plays)) (define (run-playbook pb) diff --git a/modules/ordo/task.scm b/modules/ordo/task.scm index 0b62d8d..460f40f 100644 --- a/modules/ordo/task.scm +++ b/modules/ordo/task.scm @@ -1,4 +1,5 @@ (define-module (ordo task) + #:use-module (ice-9 exceptions) #:use-module (srfi srfi-9) #:use-module (logging logger) #:use-module (ordo context) @@ -24,15 +25,19 @@ (register-playbook-var task-register-playbook-var) (triggers task-triggers)) -(define* (%task name action #:key (tags '()) (condition (const #t)) (register-play-var #f) (register-playbook-var #f) (triggers '())) - (make-task name tags action condition register-play-var register-playbook-var triggers)) - -(define-syntax task +(define-syntax assert (syntax-rules () - ((task (f args ...) kwargs ...) - (%task (symbol->string 'f) (lambda () (f args ...) kwargs ...))) - ((task name (f args ...) kwargs ...) - (%task name (lambda () (f args ...)) kwargs ...)))) + ((assert expr message irritant) + (unless expr + (raise-exception (make-exception + (make-assertion-failure) + (make-exception-with-message message) + (make-exception-with-irritants irritant))))))) + +(define* (task #:key name action (tags '()) (condition (const #t)) (register-play-var #f) (register-playbook-var #f) (triggers '())) + (assert (and name (string? name)) "#:name is required and must be a string" name) + (assert (and action (procedure? action)) "#:action is required and must be a procedure" action) + (make-task name tags action condition register-play-var register-playbook-var triggers)) (define (run-task t) (when (check-filter-tags (task-tags t))