sexta-feira, 26 de fevereiro de 2010

try/catch em Scheme

Para quem não gosta da sintaxe para tratamento de exceções de handle-exceptions (SRFI-12), a seguir está uma pequena macro para transformar a sintaxe de handle-exceptions em uma com try/catch:

(define-syntax try
(syntax-rules (catch)
((_ attempt (catch exn handler ...))
(handle-exceptions exn
(begin handler ...)
attempt))))


Exemplos de uso:

(define (try-car l #!optional default)
(try (car l)
(catch exn default)))


csi> (try-car '(1 2 3 4))
1
csi> (try-car '())
#f
csi> (try-car '() '())
()

terça-feira, 23 de fevereiro de 2010

Arc challenge em awful

Há dois anos, Paul Graham propôs o seguinte desafio (arc challenge):

Write a program that causes the url said (e.g. http://localhost:port/said) to produce a page with an input field and a submit button. When the submit button is pressed, that should produce a second page with a single link saying "click here." When that is clicked it should lead to a third page that says "you said: ..." where ... is whatever the user typed in the original input field. The third page must only show what the user actually typed. I.e. the value entered in the input field must not be passed in the url, or it would be possible to change the behavior of the final page by editing the url.


Abaixo está uma implementação para o arc challenge em awful:

(use awful html-utils spiffy-request-vars)

(define-session-page "said"
(lambda ()
(with-request-vars $ (said)
(cond (said
($session-set! 'said said)
(link "said" "click here"))
(($session 'said)
=> (lambda (said)
(++ "You said: " said)))
(else (form (++ (text-input 'said)
(submit-input))
action: "said"
method: 'post))))))


Para testar o programa, basta executar:

$ awful arc-challenge.scm


E acessar http://localhost:8080/said

terça-feira, 16 de fevereiro de 2010

doctests em Scheme

No ano passado, o Luciano Ramalho criou um grupo para estudo do livro Structure and Interpretation of Computer Programs. O grupo ainda existe mas está com as atividades paradas atualmente. Boa parte dos componentes do grupo são usuários de Python. O Luciano é um usuário de Python e mencionou a falta, em Scheme, de uma facilidade que existe em Python: a possibilidade de de especificar testes em docstrings.

A minha argumentação com relação a esta funcionalidade em Scheme é de que não deve ser feita da mesma forma como em Python, pois em Scheme, diferentemente de Python, docstrings são ambíguas. O equivalente a docstrings em Scheme só poderia ser feito através de comentários (doccomments?).

Em Python, a ambigüidade não existe porque funções exigem um comando return para indicar que a função terminará e desviará o fluxo de execução para o ponto imediatamente seguinte ao de onde foi invocada, opcionalmente, devolvendo resultados. Em Scheme, não há um comando return explícito (a menos que seja definido um procedimento de escape de uma continuação, mas este é um caso bem específico e não muito usual). O valor produzido por um procedimento é o valor resultante da última expressão avaliada. No caso de procedimentos em que a única expressão a ser avaliada é uma string, tem-se a ambigüidade. Exemplo:

(define (proc)
"Isso é uma docstring ou uma string legítima?")


A ambigüidade que ocorre com docstrings é a mesma que ocorre com doctests. Se a única expressão a ser avaliada por um procedimento for uma string, como saber a string deve ser o resultado da avaliação do procedimento ou simplesmente uma docstring? Em Scheme, é uma ambigüidade. Em Python a ambigüidade é resolvida com o comando return.

Ignorando a ambigüidade que pode ocorrer em algumas definições, implementei em Scheme um esquema semelhante a doctests em Python. A implementação não é de uso geral, mas serve como " prova de conceito" (ainda que o conceito não esteja totalmente correto :-)).

A sintaxe das strings de teste é a seguinte:

  • a expressão sob teste, que seria digitada no REPL, deve ser precedida por >

  • o resultado esperado deve ser precedido por :



O parser das strings de teste é bastante limitado. Não são admitidas múltiplas linhas para expressões de teste nem de resultado. O parser ignora linhas não iniciadas por > ou :.

A única forma sintática para declaração de procedimentos admitida é:

(define (proc args)
body)


Outras formas, como as abaixo, não são suportadas:

(define proc
(lambda (args)
body))

(define proc #f)
(set! proc (lambda (args) body))

(define proc
(let ()
(lambda (args)
body)))


Teste de procedimentos resultantes da expansão de macros também não é suportado.

A implementação consiste, basicamente, de um procedimento doctest que lê todas as formas (forms) do arquivo em que é invocado e procura por definições com o padrão

(define (proc args)
"doctest"
body)


Então a string com os testes é extraída da definição e é passada para o parser de strings de teste, o qual avalia as expressões e os resultados esperados e imprime o resultado.

Um aspecto interessante da implementação é a forma como o parsing do código é feito: com manipulação de listas (estrutura de dados usada para representar código em Scheme).

O código da implementação, em Chicken Scheme, está abaixo:

(use posix (srfi 1 13))

(define (doctest)

(define (pick-teststrings forms)
;; Retorna uma alist '((procname1 . test-string1) (proname2 . test-string2) ...)
(filter-map
(lambda (form)
(and (list? form)
(eq? (car form) 'define)
(not (null? (cddr form))) ;; (define sym)
(and (pair? (cadr form)) ;; (define (proc ...))
(string? (caddr form))
(cons (caadr form) ;; procname
(caddr form))))) ;; test-string
forms))

(define (check test result)
(let* ((error-test #f)
(error-result #f)
(err-msg (lambda (e)
(with-output-to-string (cut print-error-message e))))
(pass
(equal? (handle-exceptions e
(begin
(set! error-test (err-msg e))
#f)
(eval test))
(handle-exceptions e
(begin
(set! error-result (err-msg e))
#t)
(eval result)))))
(if (or error-test error-result)
(display
(string-append
"Erro executando "
(->string (if error-test test result))
" --> " (or error-test error-result)))
(if pass
(print test " = " result " [ok]")
(print test " != " result " [fail]")
))))

(define (parse-teststring teststring)
(define (parse-line line prefix)
(and (string-prefix? (->string prefix) line)
(with-input-from-string
(string-trim line (lambda (c) (char=? c prefix)))
read)))
(let ((tests '())
(results '()))
(for-each (lambda (line)
(set! line (string-trim-both line))
(cond ((parse-line line #\>)
=> (lambda (expr)
(set! tests (cons expr tests))))
((parse-line line #\:)
=> (lambda (expr)
(set! results (cons expr results))))))
(with-input-from-string teststring read-lines))
(values tests results)))

(let ((forms (with-input-from-file (program-name) read-file)))
(for-each (lambda (procname/teststring)
(let ((procname (car procname/teststring))
(teststring (cdr procname/teststring)))
(print "===== " procname " =====")
(let-values (((tests results) (parse-teststring teststring)))
(for-each (lambda (test result)
(check test result))
(reverse tests)
(reverse results)))
(print "")))
(pick-teststrings forms))))


Abaixo estão exemplos de uso de doctests e, em seguinda, a saída da execução dos testes:

#!/usr/bin/csi -script

(load "doctest.scm")

(define (plus a b)
" Aqui estao os testes
> (plus 3 4)
: 7
> (plus 4 5 0)
: 8
> (plus 4 5)
: 8
"

(+ a b))


(define (minus a b)
"
> (minus (plus 3 4) 3)
: 4
> (minus 4 5 0)
: 8
> (minus 4 5)
: 8
"

(- a b))

(define (sort-list-string l)
"
> (sort-list-string '(\"b\" \"o\" \"p\" \"h\" \"v\"))
: '(\"b\" \"h\" \"o\" \"p\" \"v\")
"

(sort l (cut string-ci<? <> <>)))

(define (fatorial n)
"
> (fatorial 1)
: 1
> (fatorial 2)
: 2
> (fatorial 3)
: 6
> (fatorial 5)
: 120
> (fatorial 10)
: 3
> (plus (fatorial 0) (fatorial 3))
: 7
"

(if (< n 2)
1
(* n (fatorial (sub1 n)))))

(doctest)


A saída da execução dos doctests é mostrada abaixo:

===== plus =====
(plus 3 4) = 7 [ok]
Erro executando (plus 4 5 0) --> Error: bad argument count - received 3 but expected 2: #
(plus 4 5) != 8 [fail]

===== minus =====
(minus (plus 3 4) 3) = 4 [ok]
Erro executando (minus 4 5 0) --> Error: bad argument count - received 3 but expected 2: #
(minus 4 5) != 8 [fail]

===== sort-list-string =====
(sort-list-string (quote (b o p h v))) = (quote (b h o p v)) [ok]

===== fatorial =====
(fatorial 1) = 1 [ok]
(fatorial 2) = 2 [ok]
(fatorial 3) = 6 [ok]
(fatorial 5) = 120 [ok]
(fatorial 10) != 3 [fail]
(plus (fatorial 0) (fatorial 3)) = 7 [ok]

markerpen.el

markerpen.el é uma extensão interessante para destacar regiões quaisquer de buffers do Emacs. Analogamente, é como destacar o texto de um documento com uma caneta marca-textos (daí o nome markerpen).



Para destacar uma região, basta selecionar a região desejada e executar M-x markerpen-mark-region. Para eliminar o destaque, deve-se selecionar a região e executar M-x markerpen-clear-region. Obviamente, é possível definir atalhos de teclas para esses comandos.

As cores podem ser selecionadas a partir de perfis disponibilizados pela extensão. A seleção é feita através dos comandos M-x markerpenn, onde n é um número de 1 a 10 (há 10 perfis pré-programados).

segunda-feira, 8 de fevereiro de 2010

Cálculo de fatorial através de redirecionamentos de páginas

Abaixo está uma aplicação absurdamente inútil e sem sentido usando awful: cálculo de fatorial através de redirecionamentos de páginas.

Para calcular o fatorial de 5, por exemplo, basta executar o servidor com a aplicação:

$ awful awful-fatorial.scm

e acessar http://localhost:8080/?n=5 (a entrada de dados é feita através da variável n).

O código está a seguir:

(use awful html-tags html-utils)

(root-path ".")

(define-page (main-page-path)
(lambda ()
(let* ((n ($ 'n 0 string->number))
(current ($ 'current n string->number))
(accum ($ 'accum 1 string->number))
(finished? (< current 2)))
(html-page
(if finished?
(<h1> n "! = " accum)
"")
headers: (if finished?
""
(<meta> http-equiv: "refresh"
content: (conc "0;url=?n=" n
"&accum=" (* current accum)
"&current=" (sub1 current)))))))
no-template: #t)

sábado, 6 de fevereiro de 2010

Suporte a múltiplos bancos de dados para Awful

A partir da versão 0.10, awful passa a oferecer suporte a múltiplos bancos de dados. Atualmente há suporte para PostgreSQL (através da extensão postgresql) e SQLite3 (através da extensão sqlite3 ou sql-de-lite).

Há uma extensão para cada tipo de base de dados: awful-postgresql, awful-sqlite3 e awful-sql-de-lite. No caso de SQLite3, pode-se optar por usar tanto a extensão sqlite3 ou sql-de-lite (duas extensões diferentes para acesso a bases SQLite3).

A forma de acesso a bases de dados continua praticamente a mesma: através do procedimento $db, o qual faz uso das facilidades oferecidas por awful (conexão transparente, fechamento automático). A única diferença é que agora é necessário carregar a extensão relativa ao tipo de base de dados que pretende-se acessar (e.g., (use awful awful-postgresql)) e usar enable-db como um procedimento sem argumentos, não um parâmetro com argumento booleano, como antes.

Abaixo está um exemplo completo de uma aplicação que gera uma página HTML com uma tabela contendo dados de nome e endereço da tabela users de uma base de dados PostgreSQL:

(use awful awful-sql-de-lite html-utils)

(enable-db)

(db-credentials "db.db")

(define-page (main-page-path)
(lambda ()
(tabularize ($db "select name, address from users"))))


Para publicar esta página, basta executar (supondo que o código acima está no arquivo users.scm):

$ awful users.scm


(ficará disponível em http://localhost:8080).

Se um dia for necessário migrar essa base de dados para PostgreSQL, basta usar (use awful-postgresl) em vez de (use awful-sql-de-lite) e ajustar a configuração de credenciais para acesso ao banco (no caso de SQLite3, a credencial é o caminho para o arquivo com a base de dados). Se a estrutura da base de dados não for modificada, e se forem usadas consultas SQL portáveis, o código Scheme não precisará ser alterado.

Opcionalmente, a página pode ser compilada:

$ csc -s users.scm
$ awful users.so



Simples assim. :-)