/lexer.rkt

 1#! /bin/sh
 2#| Hey Emacs, this is -*-scheme-*- code!
 3exec racket --require "$0" --main -- ${1+"$@"}
 4|#
 5
 6#lang racket
 7(require
 8 rackunit
 9 rackunit/text-ui
10 )
11
12(define (eat-ws inp)
13 (regexp-try-match #px"^[[:space:]]+" inp))
14
15(define (parse-prefix inp)
16  (regexp-match #px"[[:graph:]]+" inp))
17
18(define (parse-command inp)
19  (regexp-match #px"[0-9]{3}|[[:alpha:]]+" inp))
20
21(define (parse-params inp)
22  (let loop ([result '()])
23    (eat-ws inp)
24    (cond
25     [(eof-object? (peek-char inp))
26      (reverse result)]
27     [(char=? #\: (peek-char inp))
28      (begin
29        (read-char inp)
30        (if (eof-object? (peek-char inp))
31            result
32            (loop (cons `(param . ,(regexp-match #px"[^\u0000\r\n]+"  inp)) result))))]
33     [else
34      (loop   (cons `(param . ,(regexp-match #px"[^\u0000\r\n ]+" inp)) result))])))
35
36(check-equal? (parse-params (open-input-string ":"))
37              '())
38
39(define (parse-crlf inp )
40  (regexp-match #px"\r\n" inp))
41
42(provide parse-message)
43(define/contract parse-message
44  ((or/c string? input-port?) . -> . list?)
45  (match-lambda
46   [(? string? message)
47    (parse-message (open-input-string message))]
48   [(? input-port? message)
49    (begin0
50        (cons
51         (if (char=? #\: (peek-char message))
52             (begin
53               (read-char message)
54               (cons 'prefix (parse-prefix message)))
55             '(prefix))
56         (begin
57           (eat-ws message)
58           (begin0
59               `([command . ,(parse-command message)]
60                 [params . ,(parse-params message)])
61             (parse-crlf message)))))]))
62
63(check-equal?
64 (parse-message
65  ":offby1!n=user@pdpc/supporter/monthlybyte/offby1 PRIVMSG ##cinema :rudybot:   uptime")
66 '((prefix #"offby1!n=user@pdpc/supporter/monthlybyte/offby1")
67   (command #"PRIVMSG")
68
69   ;; Ahh! It honors multiple consecutive spaces!  The old way didn't.
70   (params (param #"##cinema") (param #"rudybot:   uptime"))))
71
72(check-equal?
73 (parse-message
74  ":nick!knack@frotz 123 #channel :some stuff")
75 '((prefix #"nick!knack@frotz")
76   (command #"123")
77   (params (param #"#channel")
78           (param #"some stuff"))))
79
80(provide main)
81(define (main)
82  (if #t
83      (call-with-input-file
84          "incoming"
85        (lambda (ip)
86          (for ([message (in-port read ip)])
87            (write (parse-message message))
88            (newline))))
89
90      (parse-message  ":anthony.freenode.net 004 rudybot anthony.freenode.net ircd-seven-1.0.1 DOQRSZaghilopswz CFILMPQbcefgijklmnopqrstvz bkloveqjfI")))