refactoring volgens skill

This commit is contained in:
2026-08-29 22:25:06 +02:00
parent 09121df0d7
commit b3a5a0b345
20 changed files with 1043 additions and 998 deletions
+109 -75
View File
@@ -1,6 +1,7 @@
#lang racket/base
(require racket/cmdline
racket/contract
racket/format
racket/string
simple-log
@@ -9,87 +10,120 @@
(provide run-player-agent-cli)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Supporting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Produce a concise description of the current agent track.
; pre : track is #f or a server-supplied track hash.
; post : No state is changed.
; result : Artist and title when available, otherwise title or filename.
; internals:
; The CLI deliberately uses server metadata and does not reopen the
; downloaded media file solely for display purposes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (track-description track)
(cond
((not track) "geen track")
(else
(define title (hash-ref track 'title #f))
(define artist (hash-ref track 'artist #f))
(define filename (hash-ref track 'filename "onbekend"))
(cond
((and artist title (not (string=? artist "")))
(format "~a — ~a" artist title))
(title title)
(else filename)))))
(let ((title (hash-ref track 'title #f))
(artist (hash-ref track 'artist #f))
(filename (hash-ref track 'filename "onbekend")))
(cond
((and artist title (not (string=? artist "")))
(format "~a — ~a" artist title))
(title title)
(else filename))))))
(define (run-player-agent-cli #:server-url [server-override #f]
#:name [name-override #f]
#:config-file [config-file #f])
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Provided functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Run the headless polling playback agent.
; pre : Overrides are #f or valid strings/paths and the configured server
; is reachable for useful operation.
; post : Configuration is persisted; runtime resources are released after
; interruption or an exception.
; result : Void after the agent has shut down.
; internals:
; One monitor thread prints only changed playback summaries. The
; shared runtime owns polling, downloads, audio and prefetch state.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (run-player-agent-cli #:server-url [server-override #f]
#:name [name-override #f]
#:config-file [config-file #f])
(->* ()
(#:server-url (or/c string? #f)
#:name (or/c string? #f)
#:config-file (or/c path-string? #f))
void?)
(sl-log-to-display)
(define loaded
(if config-file
(load-player-agent-config config-file)
(load-player-agent-config)))
(define server-url
(string-trim (or server-override
(player-agent-config-server-url loaded))))
(define name
(string-trim (or name-override
(player-agent-config-name loaded))))
(define config
(struct-copy player-agent-config loaded
(server-url server-url)
(name name)))
(save-player-agent-config! config)
(define (write-status message)
(printf "[agent] ~a~n" message)
(flush-output))
(define runtime
(make-player-agent-runtime
server-url
name
(player-agent-config-app-id config)
#:status-callback write-status
#:denied-callback
(lambda (message)
(eprintf "~a~n" message)
(flush-output (current-error-port)))))
(printf "RKT Web Player CLI Agent~n")
(printf "Naam: ~a~n" name)
(printf "Server: ~a~n" server-url)
(printf "Applicatie-ID: ~a~n" (player-agent-config-app-id config))
(printf "Stoppen: Ctrl+C~n")
(flush-output)
(define monitor #f)
(dynamic-wind
(lambda ()
((player-agent-runtime-start! runtime))
(set! monitor
(thread
(lambda ()
(let loop ((previous #f))
(define snapshot
((player-agent-runtime-snapshot runtime)))
(define summary
(cons (hash-ref snapshot 'state "stopped")
(track-description
((player-agent-runtime-current-track runtime)))))
(unless (equal? summary previous)
(printf "[playback] ~a — ~a~n" (car summary) (cdr summary))
(flush-output))
(sleep 1)
(loop summary))))))
(lambda ()
(with-handlers ((exn:break? void))
(sync never-evt)))
(lambda ()
(when (and monitor (not (thread-dead? monitor)))
(kill-thread monitor))
((player-agent-runtime-shutdown! runtime)))))
(let* ((loaded
(if config-file
(load-player-agent-config config-file)
(load-player-agent-config)))
(server-url
(string-trim (or server-override
(player-agent-config-server-url loaded))))
(name
(string-trim (or name-override
(player-agent-config-name loaded))))
(config
(struct-copy player-agent-config loaded
(server-url server-url)
(name name)))
(write-status
(λ (message)
(printf "[agent] ~a~n" message)
(flush-output)))
(runtime
(make-player-agent-runtime
server-url
name
(player-agent-config-app-id config)
#:status-callback write-status
#:denied-callback
(λ (message)
(eprintf "~a~n" message)
(flush-output (current-error-port)))))
(monitor #f))
(save-player-agent-config! config)
(printf "RKT Web Player CLI Agent~n")
(printf "Naam: ~a~n" name)
(printf "Server: ~a~n" server-url)
(printf "Applicatie-ID: ~a~n" (player-agent-config-app-id config))
(printf "Stoppen: Ctrl+C~n")
(flush-output)
(dynamic-wind
(λ ()
((player-agent-runtime-start! runtime))
(set! monitor
(thread
(λ ()
(let loop ((previous #f))
(let* ((snapshot
((player-agent-runtime-snapshot runtime)))
(summary
(cons
(hash-ref snapshot 'state "stopped")
(track-description
((player-agent-runtime-current-track runtime))))))
(unless (equal? summary previous)
(printf "[playback] ~a — ~a~n"
(car summary)
(cdr summary))
(flush-output))
(sleep 1)
(loop summary)))))))
(λ ()
(with-handlers ((exn:break? void))
(sync never-evt)))
(λ ()
(when (and monitor (not (thread-dead? monitor)))
(kill-thread monitor))
((player-agent-runtime-shutdown! runtime))))))
(module+ main
(define server-url #f)