fidzu : LISP

Dawn of the second day.

According to the internet, the thing I intend to build is called a Roguelikelike, teetering on the very edge of being a Roguelike. So it goes; we'll see if I end up taking the title or not.

Last time, we laid out the basics of prisoners, their interactions and their strategies. This time, lets get some different scenarios and some player interaction going.

Scenarios

Payoff matrices involve deciding who gets what bonus or penalty as a result of an interaction. Given a pair of defect/cooperate choices, a payoff-matrix will return the scores to be delivered to each player in turn.

(defun payoff-matrix (cc-a cc-b cd-a cd-b dc-a dc-b dd-a dd-b)
  (let ((tbl {(cons :cooperate :cooperate) (list cc-a cc-b)
              (cons :defect :cooperate) (list dc-a dc-b)
              (cons :cooperate :defect) (list cd-a cd-b)
              (cons :defect :defect) (list dd-a dd-b)}))
    (lambda (a b) (lookup tbl (cons a b)))))

Now we can define some basic scenarios. A dilemma is the name I'll pick for the situation where co-operating is better for the group, and both defecting is the worst thing for everyone, but a single defector will end out better off by defecting.

(defparameter dilemma
  (payoff-matrix
   3 3  1 5
   5 1  0 0))

A stag-hunt is a situation where a pair of players can pool their resources for a greater prize, and ignore each other for the lesser. If either player attempts to hunt the stag alone, they get nothing, while their defecting partner still gets a rabbit.

(defparameter stag-hunt
  (payoff-matrix
   3 3  0 1
   1 0  1 1))

A trade is one in which both parties benefit, but to which both parties must agree.

(defparameter trade
  (payoff-matrix
   3 3  0 0
   0 0  0 0))

A theft is one where a player takes from the other. But if both players cooperate, or both try to rob each other, they come to an impasse.

(defparameter theft
  (payoff-matrix
   0 0   -3 3
   3 -3   0 0))

A trap is a situation where cooperating leads to disaster, ignoring the situation leads to no gain, and defecting to make it clear to your partner that you don't intend to follow ends up benefiting both players.

(defparameter trap
  (payoff-matrix
   -3 -3  2 2
    2  2  0 0))

The last scenario I'll concern myself with is the mutual-prediction. Where guessing what your partner/opponent will choose benefits you, and failing to do so does nothing.

(defparameter mutual-prediction
  (payoff-matrix
   3 3  0 0
   0 0  3 3))

Adventure

In order to move through the world, our prisoners need a world to move through. Let us begin at the ending.

(defparameter ending
  {:description "You have come to the end of your long, perilous journey."})

There is nothing to do at the end other than display this fact.

(defun repl! (adventure)
  (format t "~%~%~a~%~%" (lookup adventure :description)))

THE-PRISONERS> (repl! ending)


You have come to the end of your long, perilous journey.

NIL
THE-PRISONERS>

But what led us here was a choice. An adventure is more than a description, it's also the options, a prisoner, the scenario, and a way to continue the action. continueing means making a choice and effectively playing the opposing/cooperating prisoner and abiding by the results.

(defun mk-adventure ()
  (let ((prisoner (polo)))
    {:description
     "A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\""
     :cooperate "accept" :defect "refuse" :prisoner prisoner :scenario trade
     :continue (lambda (choice)
                 (let ((their-choice (play prisoner)))
                   (update! prisoner choice)
                   (funcall trade choice their-choice)
                   ending))}))

This sort of adventure also takes a bit more machinery to run from the repl. We need to present the description, but also get an appropriate choice from the user. Getting that choice is a bit more complicated than you might think at first.

(defun get-by-prefix (lst prefix)
  (let ((l (length prefix)))
    (loop for elem in lst
       when (and (>= (length elem) l)
                 (== (subseq elem 0 l) prefix))
       do (return elem))))

(defun get-repl-choice (adventure)
  (let* ((responses (mapcar #'string-downcase (list (lookup adventure :cooperate) (lookup adventure :defect))))
         (r-map {(string-downcase (lookup adventure :cooperate)) :cooperate
                 (string-downcase (lookup adventure :defect)) :defect})
         (by-pref nil)
         (resp ""))
    (loop until (and (symbolp resp)
                     (setf by-pref
                           (get-by-prefix
                            responses
                            (string-downcase (symbol-name resp)))))
       do (format
           t "~a/~a:"
           (lookup adventure :cooperate)
           (lookup adventure :defect))
       do (setf resp (read)))
    (lookup r-map by-pref)))

Well behaved players are easy to deal with, true...

THE-PRISONERS> (get-repl-choice (mk-adventure))
Accept/Refuse:acc

:COOPERATE
T
THE-PRISONERS> (get-repl-choice (mk-adventure))
Accept/Refuse:ref

:DEFECT
T
THE-PRISONERS> (get-repl-choice (mk-adventure))
Accept/Refuse:a

:COOPERATE
T

... but we want to be a bit more general than that.

THE-PRISONERS> (get-repl-choice (mk-adventure))
Accept/Refuse:fuck you
Accept/Refuse:Accept/Refuse:boo
Accept/Refuse: (error 'error)
Accept/Refuse: (quit)
Accept/Refuse:r

:DEFECT
T
THE-PRISONERS>

That's the only hard par though. Interacting with the game once we're sure we have valid input from our player is relatively simple.

(defun repl! (adventure)
  (format t "~%~%~a~%~%" (lookup adventure :description))
  (when (contains? adventure :continue)
    (let ((choice (get-repl-choice adventure)))
      (repl! (funcall (lookup adventure :continue) choice)))))

THE-PRISONERS> (repl! (mk-adventure))


A stranger approaches. "I see you have baubles. Would you like to trade, that we both may enrich ourselves?"

Accept/Refuse:acc


You have come to the end of your long, perilous journey.

NIL
THE-PRISONERS>

This is obviously not the perilous journey being spoken of. At least, not all of it. The simplest way to extend it into one is to wrap scenarios around our existing adventure.

(defun mk-adventure ()
  (let ((def (defector)))
    {:description "A muscled street thug approachs, knife drawn."
     :cooperate "surrender" :defect "run" :prisoner def :scenario theft
     :continue (lambda (choice)
                 (let ((their-choice (play def)))
                   (update! def choice)
                   (funcall theft choice their-choice))
                 (let ((prisoner (polo)))
                   {:description
                    "A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\""
                    :cooperate "accept" :defect "refuse" :prisoner prisoner :scenario trade
                    :continue (lambda (choice)
                                (let ((their-choice (play prisoner)))
                                  (update! prisoner choice)
                                  (funcall trade choice their-choice)
                                  ending))}))}))

THE-PRISONERS> (repl! (mk-adventure))


A muscled street thug approachs, knife drawn.

Surrender/Run:run


A stranger approaches. "I see you have baubles. Would you like to trade, that we both may enrich ourselves?"

Accept/Refuse:acc


You have come to the end of your long, perilous journey.

NIL
THE-PRISONERS>

Of course, since we want it to be much longer and more perilous, we'll want that process automated to at least some degree.

(defun wrap-scenario (adventure scenario)
  (insert
   scenario
   (cons
    :continue
    (lambda (choice)
      (let* ((them (lookup scenario :prisoner))
             (their-choice (play them)))
        (update! them choice)
        (funcall (lookup scenario :scenario) choice their-choice)
        adventure)))))

(defun mk-adventure ()
  (wrap-scenario
   (wrap-scenario
    ending
    {:description
     "A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\""
     :cooperate "accept" :defect "refuse" :prisoner (polo) :scenario trade})
   {:description
    "A muscled street thug approachs, knife drawn. \"Yer money or yer life, fop!\""
    :cooperate "surrender" :defect "run" :prisoner (defector) :scenario theft}))

This isn't enough for the Roguelikelike title, and I don't think I'll get there today, but I do want the ability to make an arbitrarily long adventure. The dumbest way of doing this is to make a list of scenarios, and pick from them when the need arises.

(defun random-scenario ()
  (pick
   (list
    {:description
     "A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\""
     :cooperate "accept" :defect "refuse" :prisoner (polo) :scenario trade}
    {:description
     "A muscled street thug approachs, knife drawn. \"Yer money or yer life, fop!\""
     :cooperate "surrender" :defect "run" :prisoner (defector) :scenario theft})))


(defun mk-adventure (&key (scenarios 5))
  (let ((adventure ending))
    (loop repeat scenarios
       do (setf adventure (wrap-scenario adventure (random-scenario))))
    adventure))

An adventure of even 5 scenarios will end up being repetitive since we currently only have a grand total of two. But we can do something about that...

(defun random-scenario ()
  (pick
   (list
    {:description
     "A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\""
     :cooperate "accept" :defect "refuse" :prisoner (polo) :scenario trade}
    {:description
     "A muscled street thug approachs, knife drawn. \"Yer money or yer life, fop!\""
     :cooperate "surrender" :defect "run" :prisoner (defector) :scenario theft}
    {:description
     "As you walk through an expansive market square, a gambler motions you over. \"Fancy your chances at evens or odds?"
     :cooperate "Evens!" :defect "Odds!" :prisoner (gambler) :scenario mutual-prediction}
    {:description
     "A hunter approaches you in a forest clearing. \"Hallo there, young one. Would you help me hunt a deer? I've had enough hares for now, but I promise we'll eat well if we work together!\""
     :cooperate "<Nocks bow>" :defect "Rather go my own way" :prisoner (dantes) :scenario stag-hunt}
    {:description
     "\"Hey follow me into this bear trap!\""
     :cooperate "Sure; I've grown tired of living" :defect "No. No, I'd rather not."
     :prisoner (robin) :scenario trap}
    {:description
     "You see a merchant ahead of you, paying little attention to his overfull coin purse. You could cut it and run."
     :cooperate "It's too tempting" :defect "No; I hold strong"
     :prisoner (dantes) :scenario theft}
    {:description
     "At the end of your travails with your co-conspirator, you get to the treasure first and can pocket some if you want."
     :cooperate "Take it" :defect "No, we split fairly"
     :prisoner (gambler :defect 5) :scenario dilemma})))

This gives me some ideas about how to go about generating scenarios a lot more programmatically, but I'll leave that for later, when I'm in the right frame of mind to do cosmetic improvements.

THE-PRISONERS> (repl! (mk-adventure))

At the end of your travails with your co-conspirator, you get to the treasure first and can pocket some if you want.

Take it/Split fairly:split


You see a merchant ahead of you, paying little attention to his overfull coin purse. You could cut it and run.

It's too tempting/No:it's


"Hey follow me into this bear trap!"

Sure; I've grown tired of living/No. No, I'd rather not.:no


You see a merchant ahead of you, paying little attention to his overfull coin purse. You could cut it and run.

It's too tempting/No:it's


A stranger approaches. "I see you have baubles. Would you like to trade, that we both may enrich ourselves?"

accept/refuse:accept


You have come to the end of your long, perilous journey.

NIL
THE-PRISONERS>

This is about as far as I'm going today, and I'm not entirely sure how far I'm going during my next session.

As always, I'll let you know.

20 Sep 2020 4:25am GMT

Ok, so I guess I'm doing this.

In hopes of participating in the Autumn Lisp 2020 Game Jam, I'm going to write a multiplayer game. It's going to deal with players in several ways, implement 1FA, and probably end up being asymmetric and heavily infulenced by some readings that The Cabal have been doing lately.

But don't worry about that for the moment.

Piece by piece

The basics

(in-package #:the-prisoners)
(named-readtables:in-readtable clj:syntax)

I'm using clj. You can find it on my github, and it'll be included as part of the asd file.

Ahem.

Prisoners can do two things. They can cooperate or they can defect.

(defun coop? (res) (eq :cooperate res))
(defun defe? (res) (eq :defect res))

In order to play a game, you take the game function and apply it to the ordered list of prisoners that will be playing.

(defun play! (game &rest players)
  (apply game players))

A two-player, one-time game looks like this:

1. We take two prisoners
2. We ask them to either cooperate or defect
3. We tell each of them what the other did
4. We score them

To start with, we're going with a payoff matrix that looks like

          | Cooperate | Defect
------------------------------
Cooperate | 3, 3      | 1, 5
------------------------------
   Defect | 5, 1      | 0, 0
------------------------------

We might play with this later, but lets pretend we won't have the time.

(defun one-time (player-a player-b)
  (let ((a (funcall (lookup player-a :strategy)))
        (b (funcall (lookup player-b :strategy))))
    (if-let (update (lookup player-a :update))
      (funcall update b))
    (if-let (update (lookup player-b :update))
      (funcall update a))
    (cond ((and (coop? a) (coop? b))
           (list 3 3))
          ((and (coop? a) (defe? b))
           (list 1 5))
          ((and (defe? a) (coop? b))
           (list 5 1))
          (t
           (list 0 0)))))

The two simplest possible prisoners we can have are one who always :cooperates, and one who always :defects. A prisoner needs to be able to take into account what their opponent did last time, and separately, do something.

(defun defector ()
  {:name :defector :strategy (lambda () :defect)})

(defun cooperator ()
  {:name :cooperator :strategy (lambda () :cooperate)})

We can now play. Would you like to play a game?

The Simplest Game

THE-PRISONERS> (play! #'one-time (defector) (cooperator))
(5 1)
THE-PRISONERS> (play! #'one-time (cooperator) (defector))
(1 5)
THE-PRISONERS> (play! #'one-time (cooperator) (cooperator))
(3 3)
THE-PRISONERS> (play! #'one-time (defector) (defector))
(0 0)
THE-PRISONERS>

There are other, simple kinds of prisoners. One is the prisoner who tosses a coin and does what it tells them to.

(defun gambler ()
  {:name :gambler :strategy (lambda () (nth (random 2) (list :cooperate :defect)))})

The more general case doesn't necessarily flip a coin, but can weigh either :cooperate or :defect more strongly.

(defun gambler (&key (cooperate 1) (defect 1))
  (let ((total (+ cooperate defect))
        (moves (concatenate
                'list
                (loop repeat cooperate collect :cooperate)
                (loop repeat defect collect :defect))))
    {:name (intern (format nil "GAMBLER~a/~a" cooperate defect) :keyword)
           :strategy (lambda () (nth (random total) moves))}))

This way, we can get a true coin-flipper.

THE-PRISONERS> (gambler)
{:NAME :GAMBLER1/1 :STRATEGY #<CLOSURE (LAMBDA () :IN GAMBLER) {1003B5824B}>}
THE-PRISONERS>

Or someone who mostly cooperates/defects, but sometimes defects/cooperates.

THE-PRISONERS> (gambler :cooperate 5)
{:NAME :GAMBLER5/1 :STRATEGY #<CLOSURE (LAMBDA () :IN GAMBLER) {1003B69F0B}>}
THE-PRISONERS> (gambler :defect 5)
{:NAME :GAMBLER1/5 :STRATEGY #<CLOSURE (LAMBDA () :IN GAMBLER) {1003B6C38B}>}
THE-PRISONERS>

How do they play against each of the others? Lets find out.

The Second Simplest Game

(defun matches (elems &key (mirror? t))
  (loop for (a . rest) on elems while rest
      if mirror? collect (cons a a)
      append (loop for b in rest collect (cons a b))))

(defun all-against-all! (game matches)
  (reduce
   (lambda (memo res)
     (merge-by #'+ memo res))
   (loop for (a . b) in matches
      collect (let ((res (play! game a b)))
                {(lookup a :name) (first res) (lookup b :name) (second res)}))))

This lets us see who does better against everyone.

THE-PRISONERS> (all-against-all! #'one-time (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 13 :GAMBLER1/1 9 :GAMBLER5/1 8 :DEFECTOR 10 :COOPERATOR 8}
THE-PRISONERS> (all-against-all! #'one-time (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 8 :GAMBLER1/1 7 :GAMBLER5/1 8 :DEFECTOR 15 :COOPERATOR 10}
THE-PRISONERS> (all-against-all! #'one-time (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 10 :GAMBLER1/1 7 :GAMBLER5/1 8 :DEFECTOR 15 :COOPERATOR 8}
THE-PRISONERS> (all-against-all! #'one-time (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 11 :GAMBLER1/1 10 :GAMBLER5/1 11 :DEFECTOR 10 :COOPERATOR 6}
THE-PRISONERS>

The defector comes out on top here. And the mostly-defecting gambler doesn't do bad either. Of course, this is what we would expect from the one-time game.

An iterated game is like a series of one-time games, and it keeps a running total of the score.

(defun iterated (&key (iterations 10))
  (lambda (player-a player-b)
    (loop repeat iterations
       for (a b) = (one-time player-a player-b)
       sum a into a-sum sum b into b-sum
       finally (return (list a-sum b-sum)))))

It plays about how you'd expect

THE-PRISONERS> (play! (iterated) (defector) (cooperator))
(50 10)
THE-PRISONERS> (play! (iterated) (cooperator) (cooperator))
(30 30)
THE-PRISONERS> (play! (iterated) (defector) (defector))
(0 0)
THE-PRISONERS>

And setting the world at its' own throat works the way you'd expect of this process so far.

THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 119 :GAMBLER1/1 117 :GAMBLER5/1 105 :DEFECTOR 135 :COOPERATOR 100}
THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 132 :GAMBLER1/1 109 :GAMBLER5/1 103 :DEFECTOR 120 :COOPERATOR 100}
THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 100 :GAMBLER1/1 124 :GAMBLER5/1 92 :DEFECTOR 130 :COOPERATOR 96}
THE-PRISONERS>

There are more elaborate strategies we can call upon. I won't implement them all here, but these have been thought of.

Thoughtful Players

Robin alternates between cooperating and defecting.

(defun robin ()
  (let ((prev :cooperate))
    {:name :robin
           :strategy (lambda ()
                       (if (coop? prev)
                           (setf prev :defect)
                           (setf prev :cooperate)))}))

And then, there are the simplest strategies that consider their opponent.

(defun polo ()
  (let ((prev nil))
    {:name :polo
           :update (lambda (opponent-action) (setf prev opponent-action))
           :strategy (lambda () (or prev :cooperate))}))

(defun dantes ()
  (let ((plan :cooperate))
    {:name :dantes
           :update (lambda (action) (when (defe? action) (setf plan :defect)))
           :strategy (lambda () plan)}))

With the addition of these, it's no longer obviously a defectors game.

THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 164 :DANTES 131 :GAMBLER1/1 150 :GAMBLER5/1 169 :DEFECTOR 150 :COOPERATOR 184 :POLO 120 :ROBIN 147}
THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 168 :DANTES 126 :GAMBLER1/1 176 :GAMBLER5/1 159 :DEFECTOR 165 :COOPERATOR 184 :POLO 129 :ROBIN 136}
THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 158 :DANTES 121 :GAMBLER1/1 154 :GAMBLER5/1 156 :DEFECTOR 150 :COOPERATOR 184 :POLO 123 :ROBIN 154}
THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 163 :DANTES 131 :GAMBLER1/1 163 :GAMBLER5/1 161 :DEFECTOR 175 :COOPERATOR 184 :POLO 117 :ROBIN 146}
THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 789 :DANTES 656 :GAMBLER1/1 940 :GAMBLER5/1 964 :DEFECTOR 720 :COOPERATOR 1056 :POLO 585 :ROBIN 752}
THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 845 :DANTES 651 :GAMBLER1/1 892 :GAMBLER5/1 959 :DEFECTOR 775 :COOPERATOR 1054 :POLO 609 :ROBIN 719}
THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 788 :DANTES 651 :GAMBLER1/1 929 :GAMBLER5/1 946 :DEFECTOR 775 :COOPERATOR 1044 :POLO 609 :ROBIN 744}
THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 859 :DANTES 651 :GAMBLER1/1 867 :GAMBLER5/1 952 :DEFECTOR 765 :COOPERATOR 1048 :POLO 609 :ROBIN 729}
THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 833 :DANTES 666 :GAMBLER1/1 920 :GAMBLER5/1 953 :DEFECTOR 775 :COOPERATOR 1046 :POLO 603 :ROBIN 720}
THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 8325 :DANTES 6436 :GAMBLER1/1 9255 :GAMBLER5/1 9544 :DEFECTOR 7565 :COOPERATOR 10508 :POLO 8976 :ROBIN 7383}
THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 8365 :DANTES 6531 :GAMBLER1/1 9289 :GAMBLER5/1 9531 :DEFECTOR 7645 :COOPERATOR 10486 :POLO 6018 :ROBIN 7379}
THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 8407 :DANTES 6546 :GAMBLER1/1 9139 :GAMBLER5/1 9574 :DEFECTOR 7590 :COOPERATOR 10554 :POLO 6117 :ROBIN 7389}
THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 8063 :DANTES 6371 :GAMBLER1/1 9231 :GAMBLER5/1 9492 :DEFECTOR 7555 :COOPERATOR 10508 :POLO 6084 :ROBIN 7412}
THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 8068 :DANTES 6456 :GAMBLER1/1 9165 :GAMBLER5/1 9614 :DEFECTOR 7395 :COOPERATOR 10516 :POLO 6003 :ROBIN 7451}
THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 8241 :DANTES 6356 :GAMBLER1/1 9150 :GAMBLER5/1 9579 :DEFECTOR 7545 :COOPERATOR 10480 :POLO 9021 :ROBIN 7392}
THE-PRISONERS>

When it's a prisoner against the world, the makeup of the world makes a difference in which prisoner ultimately wins.

(defun winner (results)
  (let ((max nil)
        (score nil))
    (loop for (k . v) in (as-list results)
       do (if (or (not score) (> v score))
              (setf score v
                    max (cons k v))))
    max))

Currently, with mirror matches happening, the world is tilted towards cooperators.

THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10554)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10532)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10486)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10536)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10478)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10502)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10540)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10516)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10476)
THE-PRISONERS>

Without mirror matches, it's still mostly a cooperators' game, but not quite so strongly.

THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))

(:DEFECTOR . 7665)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:ROBIN . 7497)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:COOPERATOR . 7512)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:COOPERATOR . 7580)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:COOPERATOR . 7516)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:COOPERATOR . 7528)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:DEFECTOR . 7615)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:DEFECTOR . 7610)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:COOPERATOR . 7550)
THE-PRISONERS>

This wasn't the end. It was step one.

19 Sep 2020 12:19am GMT

This template engine is interesting because it allows mixing lisp code blocks and HTML in a way simple enough to be used by non-lisp developers and designers.

It's interesting feature is that each template definition includes the arguments list.

Here is how we can define templates for user list from the previous post about cl-emb:

POFTHEDAY> (eco:compile-string
            "
<% deftemplate user (nickname name) () %>
<a href=\"/users/<%= nickname %>\"><%= name %></a>
<% end %>
")

POFTHEDAY> (eco:compile-string "
<% deftemplate user-list (users) () %>
<ul>
  <% loop for (nickname name) in users do %>
    <li><%- user nickname name %><% end %></li>
  <% end %>
</ul>
<% end %>
")

POFTHEDAY> (eco-template:user-list
            '(("bob" "Bob Hopkins")
              ("alice" "Alice Cooker")))
"
<ul>
  
    <li>
<a href=\"/users/bob\">Bob Hopkins</a>
</li>
  
    <li>
<a href=\"/users/alice\">Alice Cooker</a>
</li>
  
</ul>
"

Also, there is a way to load templates from the files with .eco extensions. There is an ASDF extension which allows defining these templates as components of your ASDF system.

Documentation does not cover this, but the template components should be defined like this:

(defsystem mysite
  :defsystem-depends-on (eco)
  :components ((:module "src"
                :depends-on "templates"
                :components ((:file "backend-code")
                             (:file "utils")))
               (:module "templates"
                :components ((:eco-template "index-page")
                             (:eco-template "users")))))

Well, let's measure Eco's performance!

POFTHEDAY> (eco:compile-string "
<% deftemplate perform (title items) () %>
<title><%= title %></title>
<ul>
  <% loop for item in items do %>
    <li><%= item %></li>
  <% end %>
</ul>
<% end %>
")

POFTHEDAY> (time
            (loop repeat 1000000
                  do (eco-template:perform "Foo Bar"
                       '("One" "Two" "Three"))))
Evaluation took:
  2.135 seconds of real time
  2.144360 seconds of total run time (2.121050 user, 0.023310 system)
  [ Run times consist of 0.141 seconds GC time, and 2.004 seconds non-GC time. ]
  100.42% CPU
  4,713,480,570 processor cycles
  1,008,017,904 bytes consed

This is slower than half of the tested template engines. It took place between cl-who and print-html. I've expected it will be faster :(

18 Sep 2020 8:52pm GMT

This is an interesting templating library. The most interesting features are:

• named template pieces can call each other;
• debug mode allows to inspect generated code;
• different escape methods.

Here is how template functions can be reused:

POFTHEDAY> (cl-emb:register-emb "user"
            "<a href=\"/users/<% @var nickname %>\"><% @var name %></a>")

POFTHEDAY> (cl-emb:register-emb "user-list"
            "
<ul>
  <% @loop users %>
    <li><% @call user %></li>
  <% @endloop %>
</ul>
")

POFTHEDAY> (cl-emb:execute-emb "user-list"
             :env '(:users
                    ((:nickname "bob"
                      :name "Bob Hopkins")
                     (:nickname "alice"
                      :name "Alice Cooker"))))
"
<ul>
  
    <li><a href=\"/users/bob\">Bob Hopkins</a></li>
  
    <li><a href=\"/users/alice\">Alice Cooker</a></li>
  
</ul>
"

Let's see which code was generated for "user-list". To make this work, we'll need to set *debug* variable and recompile the template:

POFTHEDAY> (cl-emb:pprint-emb-function "user-list")

(LAMBDA
    (
     &KEY CL-EMB-INTERN::ENV CL-EMB-INTERN::GENERATOR-MAKER
     CL-EMB-INTERN::NAME)
  (DECLARE (IGNORABLE CL-EMB-INTERN::ENV CL-EMB-INTERN::GENERATOR-MAKER))
  (LET ((CL-EMB-INTERN::TOPENV CL-EMB-INTERN::ENV)
        (CL-EMB-INTERN::TEMPLATE-PATH-DEFAULT
         (IF (TYPEP CL-EMB-INTERN::NAME 'PATHNAME)
             CL-EMB-INTERN::NAME
             *DEFAULT-PATHNAME-DEFAULTS*)))
    (DECLARE
     (IGNORABLE CL-EMB-INTERN::TOPENV CL-EMB-INTERN::TEMPLATE-PATH-DEFAULT))
    (WITH-OUTPUT-TO-STRING (*STANDARD-OUTPUT*)
      (PROGN
       (WRITE-STRING "
<ul>
  ")
       (DOLIST
           (CL-EMB-INTERN::ENV
            (CL-EMB::AUTOFUNCALL (CL-EMB::GETF-EMB "users")))
         (WRITE-STRING "
    <li>")
         (FORMAT T "~A"
                 (LET ((CL-EMB:*ESCAPE-TYPE* CL-EMB:*ESCAPE-TYPE*))
                   (CL-EMB:EXECUTE-EMB "user" :ENV CL-EMB-INTERN::ENV
                                       :GENERATOR-MAKER
                                       CL-EMB-INTERN::GENERATOR-MAKER)))
         (WRITE-STRING "</li>
  "))
       (WRITE-STRING "
</ul>
")))))

As you can see, cl-emb generates a straight forward Lisp code.

Now let's check how fast cl-emb is and compare it to HTML template engines reviewed in previous days:

POFTHEDAY> (cl-emb:register-emb "render"
             "
<title><% @var title %></title>
<ul>
<% @loop items %><li><% @var value %></li><% @endloop %>
</ul>
")

POFTHEDAY> (time
            (loop repeat 1000000
                  do (cl-emb:execute-emb "render"
                       :env '(:title "Foo Bar"
                              :items ((:value "One")
                                      (:value "Two")
                                      (:value "Three"))))))
Evaluation took:
  1.436 seconds of real time
  1.441475 seconds of total run time (1.421158 user, 0.020317 system)
  [ Run times consist of 0.104 seconds GC time, and 1.338 seconds non-GC time. ]
  100.35% CPU
  3,172,183,256 processor cycles
  767,974,304 bytes consed

That is pretty fast. Slightly slower than Spinneret but faster than Zenekindarl.

To learn more about cl-emb's features, read it's docs!

17 Sep 2020 7:47pm GMT

This library is a port of Django templates. Its coolest feature are:

• template inheritance;
• autoreload;
• internationalization.

Also, there is nice documentation. In presence of documentation, I won't provide many examples. Instead, let's implement a small function for our HTML templating engines performance test.

I didn't find the way to load a template from the string. That is why we need to set up the library and let it know where to search template files:

POFTHEDAY> djula:*current-store*
#<DJULA:FILE-STORE {100248A8C3}>

POFTHEDAY> (djula:find-template djula:*current-store*
                                "test.html")
; Debugger entered on #<SIMPLE-ERROR "Template ~A not found" {1003D5F073}>
[1] POFTHEDAY> 
; Evaluation aborted on #<SIMPLE-ERROR "Template ~A not found" {1003D5F073}>

POFTHEDAY> (djula:add-template-directory "templates/")
("templates/")

Now we need to write such template to the templates/test.html:

<h1>{{ title }}</h1>
<ul>
{% for item in items %}
  <li>{{ item }}</li>
{% endfor %}
</ul>

And we can test it:

POFTHEDAY> (djula:find-template djula:*current-store*
                                "test.html")
#P"/Users/art/projects/lisp/lisp-project-of-the-day/templates/test.html"


(defparameter +welcome.html+ (djula:compile-template* "welcome.html"))

POFTHEDAY> (with-output-to-string (s)
             (djula:render-template* (djula:compile-template* "test.html")
                                     s
                                     :title "Foo Bar"
                                     :items '("One" "Two" "Three")))
"<h1>Foo Bar</h1>
<ul>

  <li>One</li>

  <li>Two</li>

  <li>Three</li>

</ul>
"

It is time to measure performance:

;; We need this to turn off autoreloading
;; and get good performance:
POFTHEDAY> (pushnew :djula-prod *features*)

POFTHEDAY> (defparameter *template*
             (djula:compile-template* "test.html"))

POFTHEDAY> (defun render (title items)
             (with-output-to-string (s)
               (djula:render-template* *template*
                                       s
                                       :title title
                                       :items items)))

POFTHEDAY> (time
            (loop repeat 1000000
                  do (render "Foo Bar"
                             '("One" "Two" "Three"))))
Evaluation took:
  4.479 seconds of real time
  4.487983 seconds of total run time (4.453540 user, 0.034443 system)
  [ Run times consist of 0.183 seconds GC time, and 4.305 seconds non-GC time. ]
  100.20% CPU
  9,891,631,814 processor cycles
  1,392,011,008 bytes consed

Pay attention to the line adding :djula-prod to the *features*. It disables auto-reloading. Withf enabled auto-reloading rendering is 2 times slower and takes 10.6 microseconds.

I could recommend Djula to everybody who works in a team where HTML designers are writing templates and don't want to dive into Lisp editing.

With Djula they will be able to easily fix templates and see results without changing the backend's code.

Also, today I've decided to create a base-line function which will create HTML using string concatenation as fast as possible. This way we'll be able to compare different HTML templating engines with the hand-written code:

POFTHEDAY> (defun render-concat (title items)
             "This function does not do proper HTML escaping."
             (flet ((to-string (value)
                      (format nil "~A" value)))
               (apply #'concatenate
                      'string
                      (append (list
                               "<title>"
                               (to-string title)
                               "</title>"
                               "<ul>")
                              (loop for item in items
                                    collect "<li>"
                                    collect (to-string item)
                                    collect "</li>")
                              (list
                               "</ul>")))))

POFTHEDAY> (render-concat "Foo Bar"
                          '("One" "Two" "Three"))
"<title>Foo Bar</title><ul><li>One</li><li>Two</li><li>Three</li></ul>"

POFTHEDAY> (time
            (loop repeat 1000000
                  do (render-concat "Foo Bar"
                                    '("One" "Two" "Three"))))
Evaluation took:
  0.930 seconds of real time
  0.938568 seconds of total run time (0.919507 user, 0.019061 system)
  [ Run times consist of 0.114 seconds GC time, and 0.825 seconds non-GC time. ]
  100.97% CPU
  2,053,743,332 processor cycles
  864,022,384 bytes consed

Writing to stream a little bit slower, so we'll take as a base-line the result from render-concat:

POFTHEDAY> (defun render-stream (title items)
             "This function does not do proper HTML escaping."
             (flet ((to-string (value)
                      (format nil "~A" value)))
               (with-output-to-string (out)
                 (write-string "<title>" out)
                 (write-string (to-string title) out)
                 (write-string "</title><ul>" out)
                 
                 (loop for item in items
                       do (write-string "<li>" out)
                          (write-string (to-string item) out)
                          (write-string "</li>" out))
                 (write-string "</ul>" out))))
WARNING: redefining POFTHEDAY::RENDER-STREAM in DEFUN
RENDER-STREAM
POFTHEDAY> (time
            (loop repeat 1000000
                  do (render-stream "Foo Bar"
                                    '("One" "Two" "Three"))))
Evaluation took:
  1.208 seconds of real time
  1.214637 seconds of total run time (1.196847 user, 0.017790 system)
  [ Run times consist of 0.102 seconds GC time, and 1.113 seconds non-GC time. ]
  100.58% CPU
  2,667,477,282 processor cycles
  863,981,472 bytes consed

By, the way, I tried to use str:replace-all for escaping <</code> and > symbols in the handwritten version of the render-concat function. But its performance degraded dramatically and became 36 microseconds.

str:replace-all uses cl-ppcre for text replacement.

What should I use instead?

16 Sep 2020 7:50pm GMT

Spinneret is a sexp based templating engine similar to cl-who, reviewed in post number #0075. Today we'll reimplement the snippets from the cl-who post and I'll show you a few features I'm especially like in Spinneret.

The first example is very simple. It is almost identical to cl-who, but more concise:

POFTHEDAY> (spinneret:with-html-string
             (:body
              (:p "Hello world!")))
"<body>
 <p>Hello world!
</body>"

Next example in the cl-who post showed, how to escape values properly to protect your site from JavaScript Injection attacks. With Spinneret, you don't need this, because it always escapes the values.

But if you really need to inject the HTML or JS into the page, then you have to use raw mode:

POFTHEDAY> (defclass user ()
             ((name :initarg :name
                    :reader get-name)))

POFTHEDAY> (let ((user (make-instance
                        'user
                        :name "Bob <script>alert('You are hacked')</script>")))
             (spinneret:with-html-string
               (:div :class "comment"
                     ;; Here Spinneret protects you:
                     (:div :class "username"
                           (get-name user))
                     ;; This way you can force RAW mode.
                     ;; DON'T do this unless the value is from the
                     ;; trusted source!
                     (:div :class "raw-user"
                           (:raw (get-name user))))))
"<div class=comment>
 <div class=username>
  Bob &lt;script&gtalert('You are hacked')&lt;/script&gt
 </div>
 <div class=raw-user>Bob <script>alert('You are hacked')</script>
 </div>
</div>"

With cl-who you might misuse str and esc functions. But with Spinneret there is less probability for such a mistake.

Another cool Spinneret's feature is its code walker. It allows mixing usual Common Lisp forms with HTML sexps. Compare this code snippet with the corresponding part from cl-who post:

POFTHEDAY> (let ((list (list 1 2 3 4 5)))
             (spinneret:with-html-string
               (:ul
                (loop for item in list
                      do (:li (format nil "Item number ~A"
                                      item))))))
"<ul>
 <li>Item number 1
 <li>Item number 2
 <li>Item number 3
 <li>Item number 4
 <li>Item number 5
</ul>"

We don't have to use wrappers like cl-who:htm and cl-who:esc here.

Finally, let's compare Spinneret's performance with Zenekindarl, reviewed yesterday:

POFTHEDAY> (declaim (optimize (debug 1) (speed 3)))

POFTHEDAY> (defun render (title items)
             (spinneret:with-html-string
               (:h1 title
                    (:ul
                     (loop for item in items
                           do (:li item))))))

POFTHEDAY> (time
            (loop repeat 1000000
                  do (render "Foo Bar"
                             '("One" "Two" "Three"))))
Evaluation took:
  4.939 seconds of real time
  4.950155 seconds of total run time (4.891959 user, 0.058196 system)
  [ Run times consist of 0.078 seconds GC time, and 4.873 seconds non-GC time. ]
  100.22% CPU
  10,905,720,340 processor cycles
  991,997,936 bytes consed

Sadly, but in this test Spinneret 3 times slower than Zenekindarl and CL-WHO. Probably that is because it conses more memory?

@ruricolist, do you have an idea why does Spinneret 3 times slower than CL-WHO?

14 Sep 2020 6:24pm GMT

This library can be useful for anybody who is writing services which logs their errors with backtraces. It will protect you from leaking sensitive data like passwords and tokens.

For example, let's pretend we have some code which authenticates to a database with a password. At some moment and error can happen and when you log the backtrace, the password will be logged as well:

POFTHEDAY> (defun authenticate (password)
             (format t "Authenticating with ~A"
                     password)
             (sb-debug:print-backtrace :count 3))

POFTHEDAY> (defun bar (password)
             (authenticate password))

POFTHEDAY> (bar "The Secret Password")

Authenticating with The Secret Password

Backtrace for: #<SB-THREAD:THREAD "sly-channel-1-mrepl-remote-1" RUNNING {1003692013}>
0: (AUTHENTICATE "The Secret Password")
1: (BAR "The Secret Password")
2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (BAR "The Secret Password") #<NULL-LEXENV>)

The secret-values allows to wrap the secret value into the object and retrieve the real value as needed.

POFTHEDAY> (secret-values:conceal-value "The Secret Password" :name "password")
#<SECRET-VALUES:SECRET-VALUE password {100450B623}>

POFTHEDAY> (secret-values:reveal-value *)
"The Secret Password"

Here how we can use it in our example. Pay attention to the backtrace. Now it does not contain the password and such backtrace can be written into the file or sent for diagnostic to the developer:

POFTHEDAY> (defun authenticate (password)
             (format t "Authenticating with ~A"
                     (secret-values:reveal-value password))
             (sb-debug:print-backtrace :count 3))

POFTHEDAY> (let ((pass (secret-values:conceal-value "The Secret Password")))
             (bar pass))

Authenticating with The Secret Password

Backtrace for: #<SB-THREAD:THREAD "sly-channel-1-mrepl-remote-1" RUNNING {1003692013}>
0: (AUTHENTICATE #<SECRET-VALUES:SECRET-VALUE  {10043ABB23}>)
1: (BAR #<SECRET-VALUES:SECRET-VALUE  {10043ABB23}>)
2: ((LAMBDA ()))

I definitely will use it! And you should too!

By the way, does somebody know something about the author Thomas Bakketun and his company Copyleft? Seems they are using the Common Lisp in their stack.

11 Sep 2020 4:38pm GMT

A few days ago, I tried to review a cl-vcr - a library which should remember and replay HTTP calls in your tests. But unfortunately it didn't work.

But Vincent "vindarel" did a good job, finding the similar project called vcr. It is not in Quicklisp, but can be downloaded from GitHub or Ultralisp:

https://github.com/tsikov/vcr

Today we'll check if vcr will work for remembering our HTTP calls.

First, let's make Drakma understand that application/json is a text format. Thanks to the @vseloved for this tip!

POFTHEDAY> (push '("application" . "json")
                 drakma:*text-content-types*)
(("application" . "json") ("text"))

POFTHEDAY> (drakma:http-request "https://httpbin.org/delay/5")
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Drakma/2.0.7 (SBCL 2.0.8; Darwin; 19.5.0; http://weitz.de/drakma/)\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7371-a16e828d5dc4cb52867d2d09\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/5\"
}
"
200 (8 bits, #xC8, #o310, #b11001000)
((:DATE . "Thu, 10 Sep 2020 18:41:58 GMT") (:CONTENT-TYPE . "application/json")
 (:CONTENT-LENGTH . "360") (:CONNECTION . "close")
 (:SERVER . "gunicorn/19.9.0") (:ACCESS-CONTROL-ALLOW-ORIGIN . "*")
 (:ACCESS-CONTROL-ALLOW-CREDENTIALS . "true"))
#<PURI:URI https://httpbin.org/delay/5>
#<FLEXI-STREAMS:FLEXI-IO-STREAM {100238A0A3}>
T
"OK"

Now it is time to see if our requests will be cached:

POFTHEDAY> (time
            (vcr:with-vcr "foo"
              (drakma:http-request "https://httpbin.org/delay/10")))
Evaluation took:
  10.849 seconds of real time
  
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Drakma/2.0.7 (SBCL 2.0.8; Darwin; 19.5.0; http://weitz.de/drakma/)\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7b55-4ceacc38a3d473a1e8ce9f01\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"

;; Second call returns immediately!
POFTHEDAY> (time
            (vcr:with-vcr "foo"
              (drakma:http-request "https://httpbin.org/delay/10")))
Evaluation took:
  0.001 seconds of real time
  
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Drakma/2.0.7 (SBCL 2.0.8; Darwin; 19.5.0; http://weitz.de/drakma/)\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7b55-4ceacc38a3d473a1e8ce9f01\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"

Seems the library works. But it does not support multiple values and it will break you application if it uses status code or headers, returned as the second and third values.

This is strange because I see in it's code an attempt to handle multiple values :/

Now, how about making it work with Dexador? To do this, we have to rebind the vcr:*original-fn-symbol* variable:

POFTHEDAY> (let ((vcr:*original-fn-symbol* 'dexador:request))
             (time
              (vcr:with-vcr "foo"
                (dex:get "https://httpbin.org/delay/10"))))
Evaluation took:
  10.721 seconds of real time
  
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Drakma/2.0.7 (SBCL 2.0.8; Darwin; 19.5.0; http://weitz.de/drakma/)\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7d84-7de184b7a8524404e7ecc234\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"
POFTHEDAY> (let ((vcr:*original-fn-symbol* 'dexador:request))
             (time
              (vcr:with-vcr "foo"
                (dex:get "https://httpbin.org/delay/10"))))
Evaluation took:
  0.001 seconds of real time
  
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Drakma/2.0.7 (SBCL 2.0.8; Darwin; 19.5.0; http://weitz.de/drakma/)\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7d84-7de184b7a8524404e7ecc234\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"

Ups! Why did we send "Drakma" in the User-Agent header??? Let's recheck without the vcr wrapper:

POFTHEDAY> (dex:get "https://httpbin.org/delay/10")
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Drakma/2.0.7 (SBCL 2.0.8; Darwin; 19.5.0; http://weitz.de/drakma/)\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7e04-fed39a80da9ac640b6835a00\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"
200 (8 bits, #xC8, #o310, #b11001000)
((:DATE . "Thu, 10 Sep 2020 19:27:10 GMT") (:CONTENT-TYPE . "application/json")
 (:CONTENT-LENGTH . "361") (:CONNECTION . "close")
 (:SERVER . "gunicorn/19.9.0") (:ACCESS-CONTROL-ALLOW-ORIGIN . "*")
 (:ACCESS-CONTROL-ALLOW-CREDENTIALS . "true"))
#<PURI:URI https://httpbin.org/delay/10>
#<FLEXI-STREAMS:FLEXI-IO-STREAM {1006A2DB43}>
T
"OK"

Hmm, but if we'll restart our lisp process and check it on the fresh, the result will be different (and correct):

POFTHEDAY> (dex:get "https://httpbin.org/delay/10")
"{
  \"args\": {}, 
  \"data\": \"\", 
  \"files\": {}, 
  \"form\": {}, 
  \"headers\": {
    \"Accept\": \"*/*\", 
    \"Content-Length\": \"0\", 
    \"Host\": \"httpbin.org\", 
    \"User-Agent\": \"Dexador/0.9.14 (SBCL 2.0.8); Darwin; 19.5.0\", 
    \"X-Amzn-Trace-Id\": \"Root=1-5f5a7ef4-ede1ef0036cd44c08b326080\"
  }, 
  \"origin\": \"178.176.74.47\", 
  \"url\": \"https://httpbin.org/delay/10\"
}
"
200 (8 bits, #xC8, #o310, #b11001000)
#<HASH-TABLE :TEST EQUAL :COUNT 7 {1004BD1153}>
#<QURI.URI.HTTP:URI-HTTPS https://httpbin.org/delay/10>
#<CL+SSL::SSL-STREAM for #<FD-STREAM for "socket 192.168.43.216:63549, peer: 3.221.81.55:443" {1003F79823}>>

Oh, seems, vcr is always calling dexador:http-request, because that is what it does on the top level:

(defparameter *original-fn-symbol* 'drakma:http-request)

;; The symbol original-fn is internal for the package so
;; no name conflict is possible.
(setf (symbol-function 'original-fn)
      (symbol-function *original-fn-symbol*))

Also, I found the same problem as with the original cl-vcr - this library does not use unwind-protect and in case if some error will be signalled, it will break the original drakma:http-request function :(

To finalize, I think it can be used by those who are using Drakma if somebody will fix how the multiple values are handled and original function restoration.

10 Sep 2020 7:38pm GMT

Yesterday I've reviewed fare-memoization and decided to tell you about the library I'm using for memoization instead.

The main features are ability to set TTL and an extendable caching protocol which allows to use different kinds of caches.

For example, here we'll use LRU cache which will remember only 3 results:

POFTHEDAY> (function-cache:defcached (foo :cache-class 'function-cache:lru-cache
                                          :capacity 3)
               (param)
             (format t "Not cached, returning the value: ~A~%" param)
             param)

POFTHEDAY> (foo 1)
Not cached, returning the value: 1
1

;; Now the value returned from the cache:
POFTHEDAY> (foo 1)
1

;; Let's fill the cache:
POFTHEDAY> (foo 2)
Not cached, returning the value: 2
2
POFTHEDAY> (foo 3)
Not cached, returning the value: 3
3
POFTHEDAY> (foo 4)
Not cached, returning the value: 4
4
POFTHEDAY> (foo 5)
Not cached, returning the value: 5
5

;; Value for 1 was evicted from the cache:
POFTHEDAY> (foo 1)
Not cached, returning the value: 1
1

And here is how we can set TTL and make the function result remembered for 5 seconds:

POFTHEDAY> (function-cache:defcached (foo :timeout 5)
               ()
             (let ((ts (local-time:now)))
               (format t "Not cached, returning the value: ~A~%" ts)
               ts))

POFTHEDAY> (foo)
Not cached, returning the value: 2020-09-09T22:36:05.630085+03:00
@2020-09-09T22:36:05.630085+03:00

POFTHEDAY> (foo)
@2020-09-09T22:36:05.630085+03:00

POFTHEDAY> (foo)
@2020-09-09T22:36:05.630085+03:00

POFTHEDAY> (foo)
@2020-09-09T22:36:05.630085+03:00

POFTHEDAY> (foo)
Not cached, returning the value: 2020-09-09T22:36:10.767777+03:00
@2020-09-09T22:36:10.767777+03:00

Sometimes it can be very convenient to cache rarely changed data this way.

09 Sep 2020 7:41pm GMT

This library is used by cl-vcr, reviewed yesterday.

Previously I've used another library for caching function results and fare-memoization seems interesting because it allows to "memoize" any function unless it is inlined.

Also, this "memoization" effect can be undone:

POFTHEDAY> (defun foo (a b)
             "Waits 5 seconds and multiplies a and b."
             (sleep 5)
             (* a b))

POFTHEDAY> (time (foo 2 3))
Evaluation took:
  5.003 seconds of real time

6

POFTHEDAY> (time (foo 2 3))
Evaluation took:
  5.005 seconds of real time
  
6

POFTHEDAY> (fare-memoization:memoize 'foo)

;; This call will cache it's result:
POFTHEDAY> (time (foo 2 3))
Evaluation took:
  5.004 seconds of real time
  
6

;; And next call will return immediately:
POFTHEDAY> (time (foo 2 3))
Evaluation took:
  0.000 seconds of real time
  
6

;; Now we'll undone the effect:
POFTHEDAY> (fare-memoization:unmemoize 'foo)

POFTHEDAY> (time (foo 2 3))
Evaluation took:
  5.005 seconds of real time
  
6

There is also a macro to define memoized functions and apply/funcall and remember results. The only thing I miss is the ability to cache results for a given amount of time.

Read the documentation, @ngnghm did a very good job!

08 Sep 2020 7:44pm GMT