Add qeval moduleHEADmaster

1 files changed, 46 insertions, 0 deletions

diff --git a/modules/3-eval.rkt b/modules/3-eval.rkt
new file mode 100644
index 0000000..3f28de0
--- /dev/null
+++ b/modules/3-eval.rkt
@@ -0,0 +1,46 @@
+#lang racket/base
+(require irc/core irc/bot irc/command irc/clean
+         racket/match racket/format racket/port racket/function racket/system racket/string racket/path
+         json)
+
+(define (s cmd . args)
+  (string-trim (with-output-to-string
+    (thunk (apply system* cmd args #:set-pwd? #t)))))
+
+(define syntax #px"^([[:alpha:]]+)>\\s(.*)$")
+(define evaluator-dir (getenv "EVALUATORS"))
+evaluator-dir
+
+(define evaluators
+  (let ([desc-dir (build-path evaluator-dir "desc")])
+    (for/hash ([desc-path (directory-list desc-dir #:build? #t)])
+      (values (path->string (file-name-from-path desc-path))
+              (read-json (open-input-file desc-path))))))
+
+(define (pretty-newlines s)
+  (string-replace s "\n" "⏎ "))
+
+(on (and (command-is 'PRIVMSG)
+         (suffix-match (regexp-match syntax it)))
+  (match-define (list all lang input) (regexp-match syntax (suffix)))
+  (define evaluator-cmd (build-path evaluator-dir "bin" lang))
+  (if (file-exists? evaluator-cmd)
+    (let ([output (s evaluator-cmd input)])
+      (if (zero? (string-length output))
+        (reply "<eval succeeded, but no output>")
+        (reply (string-append "> " (clean-control (pretty-newlines output))))))
+    (reply "no such handler (yet, this is still new)")))
+
+(define-command (eval)
+  #:help "Display usage information for the qeval feature"
+  (reply (format "The eval feature is invoked via 'name> code', where name is one of ~a. Use (eval-desc name) for further information"
+            (hash-keys evaluators))))
+
+(define-command (eval-desc name)
+  #:help "Describe an evaluator"
+  (define e (hash-ref evaluators (stringify name)))
+  (reply (format "The ~a evaluator has the aliases ~a, and runs with ~a MB RAM and the following software: ~a"
+                 (hash-ref e 'name)
+                 (hash-ref e 'aliases)
+                 (hash-ref e 'mem)
+                 (hash-ref e 'available))))