Woo benchmarks now complete

.travis.yml

@@ -94,7 +94,7 @@ env:
     - "TESTDIR=Java/wizzardo-http"
     - "TESTLANG=JavaScript"
     - "TESTLANG=Kotlin"
-    - "TESTLANG=Lisp"
+    - "TESTDIR=Lisp/woo"
     - "TESTLANG=Lua"
     - "TESTLANG=Nim"
     - "TESTLANG=Perl"

frameworks/Lisp/woo/benchmark_config.json

@@ -5,10 +5,14 @@
             "default": {
                 "plaintext_url": "/plaintext",
                 "json_url": "/json",
+                "fortune_url": "/fortunes",
+                "db_url": "/db",
+                "query_url": "/queries?queries=",
+                "update_url": "/updates?queries=",
                 "port": 8080,
                 "approach": "Realistic",
                 "classification": "Micro",
-                "database": "None",
+                "database": "Postgres",
                 "framework": "woo",
                 "language": "Lisp",
                 "flavor": "None",

frameworks/Lisp/woo/woo.ros

@@ -20,51 +20,168 @@ exec ros -Q -- $0 "$@"
 ;; Alexandria - https://github.com/keithj/alexandria
 ;; Optima - https://github.com/m2ym/optima
 ;; Jonathan - https://github.com/fukamachi/jonathan
+;; CL-MARKUP - https://github.com/arielnetworks/cl-markup
+;; Postmodern - https://github.com/marijnh/Postmodern
+;; QURI - https://github.com/fukamachi/quri
 
-(ql:quickload '(:uiop :woo :alexandria :optima :jonathan) :silent t)
+(ql:quickload '(:alexandria :cl-markup :jonathan :optima :postmodern :quri :uiop :woo) :silent t)
 (use-package :optima)
 
+
 (load "./helpers/starts-with.lisp")
 (load "./helpers/parse-argv.lisp")
 
 
-(defun plaintext (env)
+;; Initialize the global random state by "some means" (e.g. current time)
+(setf *random-state* (make-random-state t))
+
+
+(defun plaintext ()
   "Plaintext handler."
-  (declare (ignore env))
-  '(200 (:content-type "text/plain" :server "Woo") ("Hello, World!"))
-)
+  '(200 (:content-type "text/plain" :server "Woo") ("Hello, World!")))
 
-(defun json (env)
+(defun json ()
   "JSON handler using Jonathan to encode JSON"
-  (declare (ignore env))
-  `(200 (:content-type "application/json" :server "Woo") (,(jonathan:to-json '(:message "Hello, World!"))))
-)
+  `(200 (:content-type "application/json" :server "Woo") (,(jonathan:to-json '(:message "Hello, World!")))))
+
+(defun get-a-random-record (id)
+  (declare (integer id))
+  `(:|id| ,id :|randomNumber| ,(postmodern:query (:select 'randomnumber :from 'world :where (:= 'id id)) :single!)))
+
+(defun db ()
+  "DB handler using Jonathan to encode JSON and Postmodern to access PostgreSQL"
+  (let ((id (+ 1 (random 10000))))
+    `(
+      200
+      (:content-type "application/json" :server "Woo")
+      (,(jonathan:to-json (get-a-random-record id)))
+     )))
+
+(defun ensure-integer-is-between-one-and-five-hundreds (n)
+  (declare (integer n))
+  (if (< n 1)
+    (values 1 nil)
+    (if (> n 500)
+      (values 500 nil)
+      (values n t))))
+
+(defun extract-number-of-records-to-fetch (env)
+  (let ((n (handler-case
+            (parse-integer (cdr (assoc "queries" (quri:url-decode-params (getf env :query-string)) :test #'equal)))
+            (error (c) (values 1 c)))))
+    (ensure-integer-is-between-one-and-five-hundreds n)))
+
+(defun get-some-random-integers-between-one-and-ten-thousand (n)
+  (declare (integer n))
+  (loop :repeat n
+        :collect (+ 1 (random 10000))))
+
+(defun get-some-random-records (n)
+  (declare (integer n))
+  (let ((ids (get-some-random-integers-between-one-and-ten-thousand n)))
+    (mapcar #'get-a-random-record ids)))
+
+(defun queries (env)
+  "QUERIES handler using Jonathan to encode JSON and Postmodern to access PostgreSQL"
+  `(
+    200
+    (:content-type "application/json" :server "Woo")
+    (,(jonathan:to-json (get-some-random-records (extract-number-of-records-to-fetch env))))
+   ))
+
+(defun get-all-fortunes ()
+  (postmodern:query (:select 'id 'message :from 'fortune) :rows))
+
+(defun get-all-fortunes-plus-one ()
+  (let* ((records       (get-all-fortunes))
+         (records-p-one (append records '((0 "Additional fortune added at request time.")))))
+    (sort (copy-list records-p-one) #'string-lessp :key #'second)))
 
+(defun fortunes ()
+  "FORTUNES handler using Jonathan to encode JSON, Postmodern to access PostgreSQL and Spinneret to build the HTML"
+  `(
+     200
+     (:content-type "text/html; charset=UTF-8" :server "Woo")
+     (,(cl-markup:html5
+       (:head
+         (:title "Fortunes"))
+       (:body
+         (:table
+           (:tr
+             (:th "id")
+             (:th "message"))
+           (loop for fortune-row in (get-all-fortunes-plus-one)
+                 collect (cl-markup:markup
+                           (:tr
+                             (:td (format nil "~d" (first fortune-row)))
+                             (:td (second fortune-row)))))))))
+   ))
+
+(defun get-and-update-some-random-records (n)
+  (declare (integer n))
+  (let* ((random-records (get-some-random-records n))
+         (random-numbers (get-some-random-integers-between-one-and-ten-thousand n))
+         (index -1)
+         (updated-records (map 'list
+                               (lambda (row)
+                                       (incf index)
+                                       (list :|id|           (getf row :|id|          )
+                                             :|randomNumber| (nth index random-numbers)))
+                               random-records))
+         (record-list     (map 'list
+                               (lambda (row)
+                                       (list (nth 1 row)
+                                             (nth 3 row)))
+                               updated-records)))
+    (postmodern:query (format nil "UPDATE world AS ori SET randomnumber = new.randomnumber FROM (VALUES ~{(~{~a~^, ~})~^, ~}) AS new (id, randomnumber) WHERE ori.id = new.id" record-list))
+    (values updated-records)))
+
+(defun updates (env)
+  "UPDATES handler using Jonathan to encode JSON and Postmodern to access PostgreSQL"
+  `(
+    200
+    (:content-type "application/json" :server "Woo")
+    (,(jonathan:to-json (get-and-update-some-random-records (extract-number-of-records-to-fetch env))))
+   ))
 
 (defun handler (env)
-  "Woo router using Alexandria and Optima pattern matching."
+  "Woo router using Alexandria and Optima pattern matching"
   (optima:match env
     (
       (guard (property :path-info path) (alexandria:starts-with-subseq "/plaintext" path))
-      (funcall 'plaintext env)
+      (funcall 'plaintext)
     )
     (
       (guard (property :path-info path) (alexandria:starts-with-subseq "/json" path))
-      (funcall 'json env)
+      (funcall 'json)
     )
-  )
-)
-
+    (
+      (guard (property :path-info path) (alexandria:starts-with-subseq "/db" path))
+      (funcall 'db)
+    )
+    (
+      (guard (property :path-info path) (alexandria:starts-with-subseq "/queries" path))
+      (funcall 'queries env)
+    )
+    (
+      (guard (property :path-info path) (alexandria:starts-with-subseq "/fortunes" path))
+      (funcall 'fortunes)
+    )
+    (
+      (guard (property :path-info path) (alexandria:starts-with-subseq "/updates" path))
+      (funcall 'updates env)
+    )
+  ))
 
 (defun main (&rest argv)
   "Create and start the server, applying argv to the env"
   (let ((args (parse-argv argv)))
     (apply #'woo:run
       (lambda (env)
-        (funcall 'handler env)
-      )
+        ;; preprocessing
+        (let ((res (postmodern:with-connection '("hello_world" "benchmarkdbuser" "benchmarkdbpass" "tfb-database")
+                     (funcall 'handler env))))
+          ;; postprocessing
+          res))
       :debug nil
-      args
-    )
-  )
-)
+      args)))