Feeds:
Posts
Comments

Archive for July, 2007

I know that last time I said we would look at passing data to other pages and data sorting but instead I thought I would make a brief diversion into sqlite. Playing around with table data such as this:

a b c
1 2 3
4 5 6
7 8 9

which is rendered by:

(print-ln (render-table (make-table
                         '("a" "b" "c")
                         '(("1" "2" "3")
                           ("4" "5" "6")
                           ("7" "8" "9")))
                        '()))

is pretty uninspiring. Instead, I can use some financial data that is available from yahoo. Data for the first 50 (or so) NASDAQ stocks is available here.

(require (lib "url.ss" "net"))

(define (print-ln . args)
  (for-each display args)
  (newline))

(define *url-prefix* "http://download.finance.yahoo.com/d/quotes.csv?")
(define *url* (string-append *url-prefix*
                             "s=@%5EIXIC&f=sl1d1t1c1ohgv&e=.csv&h=50"))

(define (display-url url)
  (let ((p (get-pure-port (string->url url))))
    (let loop ((line (read-line p)))
      (unless (eof-object? line)
        (print-ln line)
        (loop (read-line p))))
    (close-input-port p)))

(display-url *url*)

Running this script gives the rather strange error message Missing Format Variable.

(url->string (string->url *url*))

reveals the reason. string->url corrupts the url! It should be this:

http://download.finance.yahoo.com/d/quotes.csv?s=@%5EIXIC&f=sl1d1t1c1ohgv&e=.csv&h=50

But instead it is this (ampersands converted to semi-colons amongst aother things):

http://download.finance.yahoo.com/d/quotes.csv?s=%40%5EIXIC;f=sl1d1t1c1ohgv;e=.csv;h=50

Yahoo rejects the later url with the error message as above.

Absolutely unbe-fricking-lievable.

I can’t imagine the thinking behind making string->url take a perfectly valid URL and breaking it. If you must do this, at least provide a function that doesn’t have this behaviour, say string->url and string->borked-url. This totally unreasonable design decision has damaged my confidence in the PLT scheme standard library. It is possible to work around the stupid default behaviour (although the fix presumably breaks URLs with semi-colons in the query string).

(require (lib "url.ss" "net")
         (lib "uri-codec.ss" "net"))

(current-alist-separator-mode 'amp)

(define (print-ln . args)
  (for-each display args)
  (newline))

(define *url-prefix* "http://download.finance.yahoo.com/d/quotes.csv?")
(define *url* (string-append *url-prefix*
                             "s=@%5EIXIC&f=sl1d1t1c1ohgv&e=.csv&h=50"))

(define (display-url url)
  (let ((p (get-pure-port (string->url url))))
    (let loop ((line (read-line p)))
      (unless (eof-object? line)
        (print-ln line)
        (loop (read-line p))))
    (close-input-port p)))

(display-url *url*)

The next step is to store the data in the database. First create a suitable table:

CREATE TABLE stock_data
(
    ticker varchar(8),
    price double,
    change double,
    date datetime
)

There is a nice csv library on planet. You declare a csv reader like this:

(define make-csv-reader
  (make-csv-reader-maker
   '((separator-chars            . (#\,))
     (strip-leading-whitespace?  . #t)
     (strip-trailing-whitespace? . #t))))

Then the functions to extract the interesting data and store it in the database. The symbol, price and change from the previous day are the first, second and fifth fields respectively. I think this csv file only changes once a day so we fix the time portion of the datetime to an arbitrary value. I haven’t named the functions particularly well here, but they should convey my intent at least.

(define (db-insert-row symbol price change)
  (let ((sql (format "
    INSERT INTO stock_data
    (ticker, price, change, date)
    VALUES
    ('~a', ~a, ~a, strftime('%Y-%m-%d 06:00:00', 'now'))
    " symbol price change)))
    (print-ln sql)
    (exec/ignore *dbh* sql)))

(define (csv-insert-into-db p)
  (let ((reader (make-csv-reader p)))
    (let loop ()
      (let ((l (reader)))
        (unless (or (null? l)
                    (null? (cdr l)))
          (let ((symbol (first l))
                (price (second l))
                (change (fifth l)))
            (db-insert-row symbol price change))
          (loop))))))

And here is the complete script:

(require (lib "1.ss" "srfi")
         (lib "url.ss" "net")
         (lib "uri-codec.ss" "net")
         (planet "csv.ss" ("neil" "csv.plt" 1 1))
         (planet "sqlite.ss" ("jaymccarthy" "sqlite.plt" 3 1)))

(current-alist-separator-mode 'amp)

(define (print-ln . args)
  (for-each display args)
  (newline))

(define *url-prefix* "http://download.finance.yahoo.com/d/quotes.csv?")
(define *url* (string-append *url-prefix*
                             "s=@%5EIXIC&f=sl1d1t1c1ohgv&e=.csv&h=50"))

(define (display-url url)
  (let ((p (get-pure-port (string->url url))))
    (let loop ((line (read-line p)))
      (unless (eof-object? line)
        (print-ln line)
        (loop (read-line p))))
    (close-input-port p)))

(define make-csv-reader
  (make-csv-reader-maker
   '((separator-chars            . (#\,))
     (strip-leading-whitespace?  . #t)
     (strip-trailing-whitespace? . #t))))

(define (db-insert-row symbol price change)
  (let ((sql (format "
    INSERT INTO stock_data
    (ticker, price, change, date)
    VALUES
    ('~a', ~a, ~a, strftime('%Y-%m-%d 06:00:00', 'now'))
    " symbol price change)))
    (print-ln sql)
    (exec/ignore *dbh* sql)))

(define (csv-insert-into-db p)
  (let ((reader (make-csv-reader p)))
    (let loop ()
      (let ((l (reader)))
        (unless (or (null? l)
                    (null? (cdr l)))
          (let ((symbol (first l))
                (price (second l))
                (change (fifth l)))
            (db-insert-row symbol price change))
          (loop))))))

(define (process-html url processor)
  (let ((p (get-pure-port (string->url url))))
    (processor p)
    (close-input-port p)))

(define *path-prefix* "c:/tmp")
(define (path p)
  (string->path (string-append *path-prefix* "/" p)))

(define *dbh* (open (path "test.db")))

(process-html *url* csv-insert-into-db)

(select *dbh* "SELECT count(*) as stocks from stock_data")
(define *results* (select *dbh* "SELECT * from stock_data"))

(for-each print-ln *results*)

(close *dbh*)

Read Full Post »

This time we said that we would talk about extracting the parameters from the query string and rendering the table. The string (srfi-13) and character set (srfi-14) SRFIs make it very easy to parse the query string.

(string-tokenize *query-string* (char-set-complement (char-set #\= #\&)))

We are not quite ready to talk about passing data from one page to another so we won’t discuss this any further until next time. How about rendering the table? Concatenating strings is messy and error-prone. We need some helper functions. e.g. let’s say there was a function tag that took a tag name, some attributes and content and formatted it into HTML. How would we want that to look? Maybe something like this?

(tag 'br) --> <br/>
(tag 'a '(href "www.google.com") "google") --> <a href="www.google.com">google</a>
(tag 'tr '() (tag 'td '() "hello")) --> "<tr><td>hello</td></tr>"

First of all, we need something to convert attributes into a string. Perhaps we might want multiple attributes or an attribute may want to concatenate a number of elements together:

e.g.

(list 'href "data=" data "&xyz=" xyz)
(define (attributes->string attributes)
  (if (pair? attributes)
      (let ((h (car attributes))
            (t (cdr attributes)))
        (if (pair? h)
            (string-join (map attributes->string attributes) " ")
            (string-append (symbol->string h)
                           "="
                           (qstr (string-concatenate t)))))
      ""))

A little helper function prefixes the attributes with a space if they result in a non-empty string.

(define (prefix-space s)
  (if (and (string? s)
           (> (string-length s) 0))
      (string-append " " s) ""))

We may not want to pass all of the parameters in so only the tag name is compulsory. Everything else is passed into args as a list. We then extract the appropriate variables parameters if there are any.

(define (tag name . args)
  (let* ((s-name (symbol->string name))
         (args-len (length args))
         (s-attributes (if (>= args-len 1)
                           (attributes->string (first args)) ""))
         (s-content (if (>= args-len 2)
                        (string-concatenate (cdr args)) ""))
         (content-length (string-length s-content)))
    (string-append "<" s-name
                   (prefix-space s-attributes)
                   (if (> content-length 0)
                       (string-append ">" s-content
                                      "</" s-name ">")
                       "/>"))))

srfi-13 provides some convenience functions for concatenating lists of strings and joining strings together.

I briefly thought about providing a nicer interface with two functions providing a tag interface without attributes and with attributes respectively and delegating to a similar function to the one above.

(define (tag name . args) ...)
(define (tag-attribs name . args) ...)

Alternatively the keyword library can be used to make a nicer interface:

(require (lib "kw.ss"))

(define/kw (tag/kw tag-name #:key attributes (content ""))
  (tag tag-name attributes content))

This would then be called like this:

(print-ln (tag/kw 'x #:attributes '(a "b")))
(print-ln (tag/kw 'td #:content "hi"))

Now that we have a tag function, we can use it to render a table. A basic table is straight-forward enough. We map a render row function across each table row, joining the result with string-join. The render row maps a function that surrounds each element with <td> … </td> string-concatenates that, and surrounds that with <tr> … </tr>. We want to alternate different classes to each row and closures are great for this. We provide a function that returns a closure that returns a different id each call.

(define (id-generator ids)
  (let ((i -1)
        (ids (list->vector ids))
        (len (length ids)))
    (lambda ()
      (set! i (+ i 1))
      (vector-ref ids (remainder i len)))))

We can the use this generator to pass a different id to the row renderer for each row in the table.

(define (render-table-row row . tr-class)
  (let ((tr-attribs (if (null? tr-class) '()
                        (list 'class (car tr-class)))))
    (tag 'tr tr-attribs
         (string-concatenate (map (lambda (e) (tag 'td '() e)) row)))))

(define (render-table table . ids)
  (let ((columns (table-columns table))
        (data (table-data table))
        (f-row (if (null? ids)
                   render-table-row
                   (let ((f (id-generator (map symbol->string (car ids)))))
                     (lambda (e)
                       (render-table-row e (f)))))))
    (tag 'table '() (string-join (map f-row data) "\n"))))

And here is a little test function:

(print-ln (render-table (make-table
                         '("a" "b" "c")
                         '(("1" "2" "3")
                           ("4" "5" "6")
                           ("7" "8" "9")))
                        '(id0 id1)))

I’m not really happy with the interface yet so maybe I’ll look at fixing that next time along with passing data from one page to the next and sorting based on the columns.

Postscript: Danny Yoo mentioned an xml library I need to look into to see if it will replace (tag …) and related functions. The uri-codec library replaces a lot of the code from the earlier article.

(define *encodings-list*
  '((%20 " ")
    (+a  "&")
    (+e  "=")
    (+p  "+")
    (+q  "\"")
    (+r  "\r\n")))

(define *hash* (make-hash-table 'equal))

(for-each (lambda (e)
            (let ((k (symbol->string (car e)))
                  (v (second e)))
              (hash-table-put! *hash* k v)
              (hash-table-put! *hash* v k)))
          *encodings-list*)

(define (encode-chars regex s)
  (pregexp-replace* regex s
                    (lambda (k)
                      (hash-table-get *hash* k))))

The data-encode and data-decode functions also become simpler as they now use the uri-encode and uri-decode functions.

(define (data-encode data)
  (let ((i (open-input-string data))
        (o (open-output-bytes)))
    (deflate i o)
    (let ((r (base64-encode (get-output-bytes o))))
      (uri-encode (bytes->string/utf-8
                   (subbytes r 0 (- (bytes-length r) 2)))))))

(define (data-decode data)
  (let ((i (open-input-bytes
            (base64-decode
             (string->bytes/utf-8
              (uri-decode data)))))
        (o (open-output-string)))
    (inflate i o)
    (get-output-string o)))

Read Full Post »

Learning Squeak

Despite the recent articles on Scheme / CGI, I’m still very interested in the Seaside web framework. I’ve worked through a couple of the tutorials up until the point at which I thought I was fairly comfortable. However, when I try to write my own app, I come unstuck right at the very beginning. I think I know why this is, and that is because my Smalltalk is far too weak. Seaside makes it easy to build a nice web-app, but you to have good enough Smalltalk to be able to implement your model.

One of the features that I found very interesting me when I started reading about Smalltalk was the extremely small number of keywords and the complete lack of precedence rules (amongst other things). This convinced me that I didn’t need to spend any effort in actually learning Smalltalk itself – I would be able to pick it up while learning Seaside. However, initially, the learning curve of Smalltalk is steeper, not shallower than other environments.

In most languages, you can learn the language, then the libraries and then start picking up the idioms and there is a fairly smooth progression. In Squeak, you have to learn the different editor windows and various ways of importing code into the image. The fact that loops and conditional is implemented in the libraries obviously doesn’t mean that you don’t need to learn about loops and conditionals. You just need to learn more of the libraries to get started than in other languages.

There are some excellent resources on learning Smalltalk the language plus the appropriate libraries of course. I chose the A Little Smalltalk book and am slowly making my way through it. My next plan is to start making a Smalltalk cheatsheet.

Read Full Post »

Last time we were looking at encoding data. HTML has a nice way of encoding its special characters, e.g. < and > are mapped to &lt; and &gt; We can do something similar. Important characters to encode are quote, equals, ampersand and maybe a few others. Then we have to decide on a character for encoding – I like plus (+) as it doesn’t look like a special character to my eyes. As we are not planning for the future, plus and a single character should do.

First of all list all the encodings.

(define *encodings-list*
  '((+s " ")
    (+a "&")
    (+e "=")
    (+p "+")
    (+q "\"")
    (+r "\r\n")))

Then store the encodings and the reverse encodings in a hash.

(define *hash* (make-hash-table 'equal))

(for-each (lambda (e)
            (let ((k (symbol->string (car e)))
                  (v (second e)))
              (hash-table-put! *hash* k v)
              (hash-table-put! *hash* v k)))
          *encodings-list*)

pregexp-replace* is perfect for encoding and decoding.

(define (encode-chars regex s)
  (pregexp-replace* regex s
                    (lambda (k)
                      (hash-table-get *hash* k))))

This would be called like

(encode-chars "[+ &\"]|\r\n" "<a string>")

I’ve decided to compress and base64 encode my data in case it becomes really big.

(define (data-encode data)
  (let ((i (open-input-string data))
        (o (open-output-bytes)))
    (deflate i o)
    (let ((r (base64-encode (get-output-bytes o))))
      (encode-chars "[+=]|\r\n"
                    (bytes->string/utf-8
                     (subbytes r 0 (- (bytes-length r) 2)))))))

We also need a decoder that performs the inverse operation.

(define (data-decode data)
  (let ((i (open-input-bytes
            (base64-decode
             (string->bytes/utf-8
              (encode-chars "\\+." data)))))
        (o (open-output-string)))
    (inflate i o)
    (get-output-string o)))

And finally, my url looks reasonable:

(print-ln "<a href=\"ser.scm?data="
          (data-encode (object->string *data*))
          "\">next page</a><br/>")

Does decode perform the inverse of encode?

(print-ln (data-decode (data-encode (object->string *data*))))

which gives:

> (("Task" "Monday" "Tuesday" "Wednesday") ("Cooking" "1hr" "1hr" "2hrs"))

The encoded data itself looks like this:

> "BcExCsAgDEDRq4Q/mdFeoXM3oXMgUougYOjg7fteShSLjnDN4bYRylfDbSPc1UcNt41K4pyz+rv+pNByG0h5LYQjrYC1R8+e"

I fixed print-ln too – display is for human-readable stuff, print is for the computer. Next time we will have to extract the data from the query string, load the data into a variable (this shouldn’t be too difficult) and think about rendering the table. For anyone following along at home, the full script is as follows:

#!mzscheme -mqf

(require (lib "1.ss" "srfi")
         (lib "pregexp.ss")
         (lib "base64.ss" "net")
         (lib "deflate.ss")
         (lib "inflate.ss"))

(define-struct table-data (columns data))

(define (print-ln . args)
  (for-each display args)
  (newline))

(define (header type)
  (string-append "Content-type: " type "; charset=iso-8859-1~n~n"))

(printf (header "text/html"))

(define *encodings-list*
  '((%20 " ")
    (+a  "&")
    (+e  "=")
    (+p  "+")
    (+q  "\"")
    (+r  "\r\n")))

(define *hash* (make-hash-table 'equal))

(for-each (lambda (e)
            (let ((k (symbol->string (car e)))
                  (v (second e)))
              (hash-table-put! *hash* k v)
              (hash-table-put! *hash* v k)))
          *encodings-list*)

(define (blank-if-null s) (if (string? s) s ""))
(define *query-string* (blank-if-null (getenv "QUERY_STRING")))

(when (> (string-length *query-string*) 0)
      (printf "[~a]<br/>~n" *query-string*))

(define (string->object s)
  (read (open-input-string s)))

(define (object->string o)
  (let ((string-port (open-output-string)))
    (write o string-port)
    (get-output-string string-port)))

(define (manifest-string-encode s)
  (pregexp-replace* "'" s "\""))

(define (manifest-string->data s)
  (string->object (manifest-string-encode s)))

(define *data* #f)

(set! *data*
      (manifest-string->data
       "(('Task' 'Monday' 'Tuesday' 'Wednesday')
         ('Cooking' '1hr' '1hr' '2hrs'))"))

(define (encode-chars regex s)
  (pregexp-replace* regex s
                    (lambda (k)
                      (hash-table-get *hash* k))))

(define (data-encode data)
  (let ((i (open-input-string data))
        (o (open-output-bytes)))
    (deflate i o)
    (let ((r (base64-encode (get-output-bytes o))))
      (encode-chars "[+=]|\r\n"
                    (bytes->string/utf-8
                     (subbytes r 0 (- (bytes-length r) 2)))))))

(define (data-decode data)
  (let ((i (open-input-bytes
            (base64-decode
             (string->bytes/utf-8
              (encode-chars "\\+." data)))))
        (o (open-output-string)))
    (inflate i o)
    (get-output-string o)))

(print-ln "<a href=\"ser.scm?data="
          (data-encode (object->string *data*))
          "\">next page</a><br/>")

(print-ln "<a href=\"ser.scm\">Restart</a><br>")

(print-ln (data-decode (data-encode (object->string *data*))))

(exit)

Read Full Post »

Follow

Get every new post delivered to your Inbox.