(blog ‘lucindo)

Um snippet de teste que eu fiz para um serviço REST usando Hunchentoot.

Usando função genérica é possível fazer um “pattern matching” e a implementação fica parecida com Erlang/YAWS (a vir no BedDB).

(eval-when (:load-toplevel :compile-toplevel :execute)
  (require ‘hunchentoot))

(defpackage :ht-rest
  (:use :common-lisp :hunchentoot))

(in-package :ht-rest)

(defun add-dispatcher (dispatcher-fn)
  “Helper function to add dispatcher functions to dispatch table”
  (nconc *dispatch-table* (list dispatcher-fn)))

(defun create-dispatcher (url-prefix handler &key (regexp nil))
  “Creates a dispatcher and add it to dispatch table given the
url prefix and handler function. The url prefix can be a regular
expression (in this case set the :regexp keyword).”
  (let ((dispatcher-fn
         (funcall
          (if regexp ‘create-regexex-dispatcher ‘create-prefix-dispatcher)
          url-prefix handler)))
    (add-dispatcher dispatcher-fn)))

(defun handle-rest ()
  “Simply delegate to appropriate handler”
  (handle (request-method)))

(defgeneric handle (request-method)
  (:documentation “Generic REST handler”))

(defmethod handle :before (request-method)
  (log-message :info “REST in: [method ~a] [target ~a] [qs ~s]”
               (request-method) (script-name) (query-string)))

(defmethod handle :after (request-method)
  (log-message :info “REST out: [code ~a] [method ~a] [target ~a] [qs ~s]”
               (return-code) (request-method)
               (script-name) (query-string)))

(defmethod handle ((request-method (eql :get)))
  (string (request-method)))

(defmethod handle ((request-method (eql :post)))
  (string (request-method)))

(defmethod handle ((request-method (eql :put)))
  (string (request-method)))

(defmethod handle ((request-method (eql :delete)))
  (string (request-method)))

(defmethod handle (request-method)
  (setf (return-code) +http-method-not-allowed+))

(defvar *ht-server* nil)

(defun setup ()
  (create-dispatcher “/rest” ‘handle-rest))

(defun start (&optional (setup-p t))
  (prog1
      (setq  *show-lisp-errors-p* t
             *show-lisp-backtraces-p* t
             *dispatch-table* (list ‘dispatch-easy-handlers)
             *ht-server* (start-server :port 8080))
    (when setup-p (setup))))

(defun stop ()
  (stop-server *ht-server*))

(defun re-start ()
  (progn
    (stop)
    (start nil)))

O Ivan colocou na sua página dois benchmarks interessantes:

• Expressões regulares: tempo para verificar se 170K strings são URLs
• “Hello Interwebs!”: número de requests por segundo em uma página dinâmica

Linguagens testadas: C, C++, Java, Perl, Python, Ruby, Ocaml, PHP, D, Erlang e Common Lisp.

Observação: Nenhum dos testes prova nada além do que um bando de programadores não tem nada mais para fazer da vida depois rola uma discussão na hora do café.

… vem o Herrmann e manda:

Herrmann (5:49):
Cara, minha revelação do dia: me liguei que o axioma K (L(p>q)>(Lp>Lq)) de lógica modal é isomórfico ao operador de aplicação de mônadas (ap :: Monad m => m (a -> b) -> m a -> m b), de acordo com o isomorfismo de Curry-Howard
Herrmann (5:50):
Acho que rola usar um método de tableaux analítico pra ajudar a compilar
Lucindo (5:50):
entendi lhufas

Update: ele achou depois um link sobre isso. E eu continuo não entendendo.

Fiz um pacote que é um conjunto de funções e macros para facilitar o uso do Postmodern.

Download: http://www.lucindo.com.br/lisp/postmodern-utils.tar.gz

É possível instalar com ASDF-Install:

* (require :asdf-install)
* (asdf-install:install "http://lucindo.com.br/lisp/postmodern-utils.tar.gz")

Com ele é possível fazer o seguinte:

(eval-when (:execute)
  (setf postmodern-utils:*db-name* “db-name”
        postmodern-utils:*db-user* “username”
        postmodern-utils:*db-pass* “password”
        postmodern-utils:*db-host* “server”))

Depois disso você pode usar a macro with-pooled-connection para todo código que precise acessar o banco, como por exemplo:

(defmacro update-dao-attribute (type id accessor-fn new-value)
  (let ((dao (gensym)))
    `(with-pooled-connection
         (with-transaction ()
           (let ((,dao (get-dao type id)))
             (progn
               (setf (,accessor-fn ,dao) ,new-value)
               (save-dao ,dao)))))))

Nesse pacote ainda temos a função create-table-if-not-exists, a macro with-new-connection. A função que motivou o desenvolvimento dessa lib foi select-daos. Ela funciona como a select-dao do Postmodern, só que aceita alguns parâmetros (keyword) a mais:

(with-new-connection
 (select-daos 'entity :test '(:> attr1 100))

Mais exemplos:

(select-daos 'entity)
(select-daos 'entity :limit 20)
(select-daos 'entity :limit 20 :offset 40)
(select-daos 'entity :order-by 'attr2)
(select-daos 'entity :order-by '(:desc attr2))
(select-daos 'entity
	     :test '(:> attr1 100)
	     :order-by '(:desc attr2)
	     :limit 100
	     :offset 200)

Brincando um pouco com Postmodern:

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :postmodern))

(defpackage :pg-test
  (:use :cl :postmodern))

(in-package :pg-test)

(defparameter *db-name* “lucindo”)
(defparameter *db-user* “lucindo”)
(defparameter *db-pass* “”)
(defparameter *db-host* “localhost”)

;; global connection
(eval-when (:execute)
  (connect-toplevel *db-name* *db-user* *db-pass* *db-host*))

;; defines a table (and a CLOS class)
(deftable user ()
  ((id :type integer
       :initarg :id
       :accessor id)
   (name :type (or string db-null)
         :initarg :name
         :initform :null
         :accessor name)
   (points :type (numeric 10 3)
           :initarg :points
           :accessor points))
  (:indices id points)
  (:class-name user))

;; creates the table if not exists
(defun setup ()
  (when (not (table-exists-p :user))
    (create-table ‘user)))

(defun create-update-user (id name &optional (points 0.0))
  (save-dao (make-instance ‘user :id id :name name :points points)))

(defun get-user-by-id (id)
  (get-dao ‘user id))

Se você precisar escrever SQL pode usar o mapeamento para expressões Lisp, como:

(:select ‘relname
         :from ‘pg-catalog.pg-class
         :inner-join ‘pg-catalog.pg-namespace
         :on (:= ‘relnamespace ‘pg-namespace.oid)
         :where (:and (:= ‘relkind “r”)
                      (:not-in ‘nspname (:set “pg_catalog” “pg_toast”))
                      (:pg-catalog.pg-table-is-visible ‘pg-class.oid)))

A lib é bem completa, com connection pools, prepared statements, … e 100% Common Lisp (você não precisa ter nada do PostgreSQL instalado na máquina cliente).

Update: deftable não tem suporte a foreign keys

E não é que funciona! Usei:

• Hunchentoot
• HT-AJAX
• CL-WHO

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :hunchentoot)
  (require :cl-who)
  (require :ht-ajax))

(defpackage :ajax-test
  (:use :cl :hunchentoot :cl-who)
  (:export #:start-web #:stop-web))

(in-package :ajax-test)

;; local directory with lokris.js
(defparameter */static-local-dir* “/Users/lucindo/Documents/Lisp/tmp/”)
;; can be any url
(defparameter *ajax-handler-url* “/ajax”)
;; using lokris (very small)
(defparameter *ajax-processor* (ht-ajax:make-ajax-processor
                                :type :lokris
                                :server-uri *ajax-handler-url*
                                :js-file-uris “/static/lokris.js”))

;; hunchentoot handlers setup
(eval-when (:compile-toplevel :load-toplevel :execute)
  (setf *dispatch-table*
        (list ‘dispatch-easy-handlers
              (create-folder-dispatcher-and-handler “/static/”
                                                    */static-local-dir*
                                                    “text/plain”)
              (create-prefix-dispatcher *ajax-handler-url*
                                        (ht-ajax:get-handler
                                         *ajax-processor*))
              (create-prefix-dispatcher “/js” ‘java-script)
              (create-prefix-dispatcher “/” ‘main-page))))

(defparameter *web-server* nil)

(defun start-web (&optional (port 4242))
  (setf *web-server* (start-server :port port)))

(defun stop-web ()
  (stop-server *web-server*))

;; eval and print a lisp expression
(defun testfunc (command)
  (prin1-to-string (eval (read-from-string command nil))))
(ht-ajax:export-func *ajax-processor* ‘testfunc :method :post)

(defun java-script ()
  “function command_clicked(txt) {
    var command = document.getElementById(’command’).value;
    ajax_testfunc_set_element(’result’, command); }”)

(defun main-page ()
  (with-html-output-to-string (*standard-output* nil :prologue t)
    (:html
     (:head
      (:script :type “text/javascript” :src “/js”)
      (:title “AJAX test”))
      (fmt “~a” (ht-ajax:generate-prologue *ajax-processor*))
     (:body
      (:h1 “AJAX test”)
      (:table :width “50%”
              (:tr
               (:td :colspan “2″
                    (:span :id “result”
                           (:i “no results yet”))))
              (:tr
               (:td :width “70%”
                    (:input :type “text”
                            :size “70″
                            :name “command”
                            :id “command”))
               (:td
                (:input :type “button”
                        :value “Eval”
                        :onclick “javascript:command_clicked();”))))))))

Source: ajax-test.lisp (nele mudei para usar Prototype. O legal é o que o HT-AJAX suporta vários processadores ajax: Lokris, Prototype, Dojo, Yahoo! [YUI]).

Se você também não gosta de HTML junto com código pode usar HTML-TEMPLATE. Se você não gosta mesmo de HTML pode usar o Weblocks em que o design fica em CSS e o resto é codigo Lisp (o framework gera todo o HTML e JavaScript para AJAX).

Quase tudo tendo como base Ediware.

Seguindo instruções do Herrmann..

algor:~ lucindo$ ghci
   ___         ___ _
  / _  /  // __(_)
 / /_// /_/ / /  | |      GHC Interactive, version 6.6.1, for Haskell 98.
/ /_\/ __  / /___| |      http://www.haskell.org/ghc/
____// /_/____/|_|      Type : ? for help.

Loading package base ... linking ... done.
Prelude> let fibs = 1 : 1 : zipWith (+) fibs (tail fibs)
Prelude> take 10 fibs
[1,1,2,3,5,8,13,21,34,55]
Prelude> zip [1..] "lisp"
[(1,'l'),(2,'i'),(3,'s'),(4,'p')]
Prelude>

Achei muito doce.

However, C++ isn’t meant to be everything to everybody. No one programming language and no one view of how to write programs is sufficient for everything. Constraints-based programming, logic programming, functional programming, and various forms of concurrent programming are examples of good and useful styles of programming not supported by C++.

Bjarne Stroustrup, em Why C++is not just an Object-Oriented Programming Language

Tem gente que acredita que algoritmos e linguagens de programação são dois mundos distintos. Eu discordo. São raríssimas as pessoas que conseguem separar as duas coisas, incluse eu e você que está lendo isso.

Pegue qualquer livro de introdução a algoritmos e estrutura de dados, pode até mesmo ser um clássico. Os algoritmos são dados em uma linguagem de programação. Pseudo-código é baseado numa linguagem de programação. Todo pseudo-código que eu conheço é pseudo-C ou pseudo-Pascal (um pseudo-Algol-like), inclusive a maioria dos que eu escrevo (pelo menos até agora).

Quando pensamos num problema e estamos desenvolvendo um algoritmo para resolvê-lo estamos limitados às ferramentas de construção de algoritmos que conhecemos, que aprendemos. Mas mais do que isso, acabamos usando as que estamos mais acostumados. Um exemplo disso são algoritmos recursivos. Eu conheço um sem número de programadores com uma dificuldade tremenda de entender recursão. Eu sei que é um exemplo simples e que todo programador deveria saber recursão. Mas pegue uma linguagem mainstream, escolha um projeto qualquer open source e veja quantas definições recursivas você encontra.

Digo isso por experiência própria. Eu aprendi e entendi recursão como todo mundo no curso de computação, mas eu quase nunca pensava recursivamente. Quando eu fui programar em Erlang pela primeira vez, de cara o obstáculo foi single assignment. “Como assim eu não posso fazer i++?”. “Não dá pra fazer quase nada se não dá pra fazer i++!”. “Que linguagem tosca!!”. Acontece que dá para fazer de tudo sem i++ e coisas assim te forçam a exercitar outras formas de resolver problemas, como usar recursão e todo pensamento indutivo que você precisa para isso.

Mas como eu disse, recursão é um exemplo tolo. O grande problema que eu vejo é que o Blub Paradox está diretamente ligado não apenas à linguagem de programação mas também na forma como pensamos e resolvemos problemas, ou seja, como desenvolvemos algortimos.

Agora um exercício de uma dessas coisas que a maioria das pessoas acha perda de tempo.

Segundo a Wikipedia Memoização é: “… memoization is an optimization technique used primarily to speed up computer programs by storing the results of function calls for later reuse, rather than recomputing them at each invocation of the function…“.

Memoização é uma técnica, assim como muitas outras coisas, como backtracking, como programação dinânima, como divisão e conquista. E porque não como design patterns? São técnicas.

Fica difícil definir memoização como um algoritmo em pseudo-código, mas não porque não seja possível, mas porque falta alguma coisa no pseudo-código, no pseudo-C. Memoização poderia se resumir simplesmente ao algoritmo memoizar que recebe como entrada uma função e devolve a mesma função memoizada. Tendo esse algoritmo seria possível escrever algo assim em JavaScript:

function fib(n) {
    if (n == 0) {
        return 0;
    } else if (n == 1) {
        return 1;
    }
    return fib(n - 1) + fib(n - 2);
}

function test(n) {
    var t1 = new Date();
    var v = fib(n);
    var t2 = new Date();
    print(“fib(”+ n + “) = “+ v + ” took: “ + (t2 - t1) + ” ms”);
}

function runtest() {
    test(42);
    fib = memoize(fib);
    test(42);
}

Dessa forma seria natural pensar que utilizando a função memoize a segunda chamada a test(42) fosse mais rápida que a primeira. De fato, é o que realmente acontece:

fib(42) = 267914296 took: 279094 ms
fib(42) = 267914296 took: 20 ms


A implementação de memoize é simples numa linguagem de programação com suporte a higher-order functions, mas eu não sei fazer algo parecido numa linguagem como Java/C# (por exemplo).

function memoize(fun) {
    var cache = new Array();
    return function () {
        arguments.toString = Array.prototype.toString;
        if (cache[arguments.toString()] == undefined) {
            var value = fun(arguments);
            cache[arguments.toString()] = value;
        }
        return cache[arguments.toString()];
    }
}

Essa é uma idéia de memoização que o Peter Norvig apresenta no PAIP.
De novo, isso não serve para nada, além claro de mudar um pouco a maneira como pensamos em resolver problemas. Alguns que concordam:

Lisp has jokingly been called “the most intelligent way to misuse a computer”. I think that description is a great compliment because it transmits the full flavor of liberation: it has assisted a number of our most gifted fellow humans in thinking previously impossible thoughts.

Edsger Dijkstra, CACM, 15:10

Lisp is worth learning for the profound enlightenment experience you will have when you finally get it; that experience will make you a better programmer for the rest of your days, even if you never actually use Lisp itself a lot.

Eric Raymond

Lisp … made me aware that software could be close to executable mathematics.

L. Peter Deutsch

Although my own previous enthusiasm has been for syntactically rich languages, like the Algol family, I now see clearly and concretely the force of Minsky’s 1970 Turing Lecture, in which he argued that Lisp’s uniformity of structure and power of self reference gave the programmer capabilities whose content was well worth the sacrifice of visual form.

Robert Floyd, Turing Award Lecture, 1979