Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Lots of ()s to []s in conventional places.

  • Loading branch information...
commit 979447168dcf2122b389a40760ef6b2e0093969a 1 parent 5166ffb
@elibarzilay elibarzilay authored
View
18 analyze-quotes.rkt
@@ -16,8 +16,8 @@
[ymin (vector-ref (car vecs) 1)]
[ymax (vector-ref (car vecs) 1)])
([p (in-list vecs)])
- (let ((x (vector-ref p 0))
- (y (vector-ref p 1)))
+ (let ([x (vector-ref p 0)]
+ [y (vector-ref p 1)])
(values (min x xmin)
(max x xmax)
(min y ymin)
@@ -38,12 +38,12 @@
(lambda (ip)
(define (hash-table-increment! table key)
(hash-update! table key add1 0))
- (let ((counts-by-quote (make-hash) )
- (histogram (make-hash)))
+ (let ([counts-by-quote (make-hash) ]
+ [histogram (make-hash)])
(printf "Reading from ~a ...~%" *ifn*)
(printf "Read ~a lines.~%"
- (for/and ((line (in-lines ip))
- (count (in-naturals)))
+ (for/and ([line (in-lines ip)]
+ [count (in-naturals)])
(match line
[(regexp #px"=> \"PRIVMSG #emacs :(.*)\"$" (list _ stuff))
(when (and (not (regexp-match #px"^\\w+:" stuff))
@@ -53,11 +53,11 @@
count)
)
(printf "Snarfed ~a distinct quotes.~%" (hash-count counts-by-quote))
- (for (((k v) (in-hash counts-by-quote)) )
+ (for ([(k v) (in-hash counts-by-quote)] )
(hash-table-increment! histogram v))
(printf "Histogram: ~a~%" histogram)
- (let ((vecs (hash-map histogram vector)))
- (let-values (([xmin xmax ymin ymax] (bounding-box vecs)))
+ (let ([vecs (hash-map histogram vector)])
+ (let-values ([(xmin xmax ymin ymax) (bounding-box vecs)])
(plot (points vecs)
#:x-label "Number of Occurrences"
#:y-label "Quotes"
View
2  clearenv.rkt
@@ -11,7 +11,7 @@ exec racket --require "$0" --main -- ${1+"$@"}
(unsafe!)
(define (clearenv)
- (let ((func (get-ffi-obj 'clearenv #f (_fun -> _void))))
+ (let ([func (get-ffi-obj 'clearenv #f (_fun -> _void))])
(when (procedure? func)
(func))))
View
81 irc-process-line.rkt
@@ -44,7 +44,7 @@
;; nick. If we were to display them all, they might get truncated,
;; due to the 500-character output limit. So userinfo always gives
;; us at most two of the recent ones.
- (let ((ss (lookup-sightings n)))
+ (let ([ss (lookup-sightings n)])
(if (null? ss)
(format "No sign of ~a" n)
(string-join
@@ -54,7 +54,7 @@
(aif it (sighting-action? info) (string-append it " ") "")
(sighting-where info)
(describe-since (sighting-when info))
- (let ((words (string-join (sighting-words info))))
+ (let ([words (string-join (sighting-words info))])
(if (positive? (string-length words))
(format ", saying \"~a\"" words)
""))))
@@ -79,13 +79,13 @@
(define last-give-instructions #f)
(define (out format-string . args)
- (let* ((str (apply format format-string args))
- (str (if (> (string-length str) *max-output-line*)
+ (let* ([str (apply format format-string args)]
+ [str (if (> (string-length str) *max-output-line*)
(string-append (substring str 0 (- *max-output-line* 4)) " ...")
- str))
+ str)]
;; don't display newlines, so that Bad Guys won't be able
;; to inject IRC commands into our output.
- (str (regexp-replace* #rx"[\n\r]" str " <NEWLINE> ")))
+ [str (regexp-replace* #rx"[\n\r]" str " <NEWLINE> ")])
(log "=> ~a" str)
(fprintf (*irc-output*) "~a~%" str)))
@@ -223,7 +223,7 @@
;; Original Rudybot, so avoid annoying duplicates from multiple
;; bots
(when (regexp-match? #rx"^rudybot" (unbox *my-nick*))
- (for ((word (in-list (cons first-word rest))))
+ (for ([word (in-list (cons first-word rest))])
(match word
[(regexp url-regexp (list url _ _))
(when (<= 75 (string-length url))
@@ -239,9 +239,9 @@
;; our nick, rather than just the comma and colon I've
;; hard-coded here.
[(regexp #px"^([[:alnum:]_-]+)[,:](.*)" (list _ addressee garbage))
- (let ((words (if (positive? (string-length garbage))
+ (let ([words (if (positive? (string-length garbage))
(cons garbage rest)
- rest)))
+ rest)])
(if (and (not (null? words))
(equal? addressee (unbox *my-nick*)))
(parameterize ([*full-id* full-id])
@@ -249,8 +249,7 @@
(and #f
(not (regexp-match #rx"^offby1" nick))
(equal? target "#emacs" ))))
- ((*incubot-server*) 'put (string-join (cons first-word rest) " ")))
- )]
+ ((*incubot-server*) 'put (string-join (cons first-word rest) " "))))]
[(regexp #px",+\\.+")
(when (equal? target "#emacs")
(pm target "Woof."))]
@@ -275,7 +274,7 @@
[(list digits mynick blather ...)
(case (string->number digits)
- ((1)
+ [(1)
(log "Yay, we're in")
(set-box! *authentication-state* 'succeeded)
;; BUGBUG --this appears to be to soon to join. _Most_
@@ -287,15 +286,15 @@
;; authenticate..
;; ":NickServ!NickServ@services. NOTICE rudybot :You are now identified for \u0002rudebot\u0002."
- (for ([c (*initial-channels*)]) (out "JOIN ~a" c)))
- ((366)
+ (for ([c (*initial-channels*)]) (out "JOIN ~a" c))]
+ [(366)
(log "I, ~a, seem to have joined channel ~a."
mynick
- (car blather)))
- ((433)
+ (car blather))]
+ [(433)
(log "Nuts, gotta try a different nick")
(set-box! *my-nick* (string-append (unbox *my-nick*) "_"))
- (out "NICK ~a" (unbox *my-nick*))))]
+ (out "NICK ~a" (unbox *my-nick*))])]
[(list)
(log "Completely unparseable line from the server. current-words ~s; host ~s"
(*current-words*)
@@ -380,12 +379,12 @@
[_ (raise-syntax-error 'defverb "malformed defverb" stx)])))
(define (reply fmt . args)
- (let* ((response-target (*response-target*))
- (for-whom (*for-whom*))
- (response-prefix (if (equal? response-target for-whom)
+ (let* ([response-target (*response-target*)]
+ [for-whom (*for-whom*)]
+ [response-prefix (if (equal? response-target for-whom)
(if (is-master?) "* " "")
(format (if (is-master?) "*~a: " "~a: ")
- for-whom))))
+ for-whom))])
(pm response-target "~a~a" response-prefix (apply format fmt args))))
;; ----------------------------------------------------------------------------
@@ -407,7 +406,7 @@
(reply "~a" (git-version)))
(defverb (quote) "words of wisdom"
- (let ((q (one-quote)))
+ (let ([q (one-quote)])
;; special case: jordanb doesn't want quotes prefixed with his nick.
(match (*for-whom*)
[(regexp #rx"^jordanb") (pm (*response-target*) "~a" q)]
@@ -440,7 +439,7 @@
(define (call/whine f . args)
(define (on-error e)
- (let ((whine (if (exn? e) (exn-message e) (format "~s" e))))
+ (let ([whine (if (exn? e) (exn-message e) (format "~s" e))])
(reply ;; make sure our error message begins with "error: ".
(if (regexp-match? #rx"^error: " whine) "~a" "error: ~a")
whine)))
@@ -468,12 +467,12 @@
;; catch _all_ exceptions from the sandbox, to prevent "eval (raise 1)" or
;; any other error from killing this thread (including creating the sandbox).
(when give-to
- (cond ((equal? give-to (unbox *my-nick*)) (error "I'm full, thanks."))
- ((equal? give-to for-whom)
+ (cond [(equal? give-to (unbox *my-nick*)) (error "I'm full, thanks.")]
+ [(equal? give-to for-whom)
;; allowing giving a value to yourself can lead to a nested call
;; to `call-in-sandbox-context' which will deadlock.
- (error "Talk to yourself much too?"))))
- (let ((s (get-sandbox)))
+ (error "Talk to yourself much too?")]))
+ (let ([s (get-sandbox)])
(call-with-values (lambda () (sandbox-eval s (text-from-word words)))
(lambda values
;; Even though the sandbox runs with strict memory and time limits, we
@@ -486,30 +485,30 @@
(define (display-values values displayed shown?)
(define (next s?)
(display-values (cdr values) (add1 displayed) s?))
- (cond ((null? values) shown?)
- ((void? (car values)) (next shown?))
+ (cond [(null? values) shown?]
+ [(void? (car values)) (next shown?)]
;; prevent flooding
- ((>= displayed *max-values-to-display*)
+ [(>= displayed *max-values-to-display*)
(reply
"; ~a values is enough for anybody; here's the rest in a list: ~s"
(number->english *max-values-to-display*)
(filter (lambda (x) (not (void? x))) values))
- #t)
- (else (reply "; Value~a: ~s"
+ #t]
+ [else (reply "; Value~a: ~s"
(if (positive? displayed)
(format "#~a" (add1 displayed))
"")
(car values))
;; another precaution against flooding.
(sleep 1)
- (next #t))))
+ (next #t)]))
(define (display-values/give)
- (cond ((not give-to) (display-values values 0 #f))
- ((null? values)
- (error "no value to give"))
- ((not (null? (cdr values)))
- (error "you can only give one value"))
- (else
+ (cond [(not give-to) (display-values values 0 #f)]
+ [(null? values)
+ (error "no value to give")]
+ [(not (null? (cdr values)))
+ (error "you can only give one value")]
+ [else
(sandbox-give s give-to (car values))
;; BUGBUG -- we shouldn't put "my-nick" in the
;; string if we're talking to a nick, as opposed to
@@ -531,9 +530,9 @@
(cons response-target (current-seconds)))
(pm response-target
"~a: ~a ~a" give-to for-whom msg))))
- #t))) ; said something
+ #t])) ; said something
(define (display-output name output-getter)
- (let ((output (output-getter s)))
+ (let ([output (output-getter s)])
(and (string? output) (positive? (string-length output))
(begin (reply "; ~a: ~s" name output) (sleep 1) #t))))
(unless (or (display-values/give)
View
8 iserver.rkt
@@ -48,14 +48,14 @@
[*from-server* (make-channel)])
(define funcs-by-symbol
(make-immutable-hash
- `((get .
+ `([get .
,(lambda (inp c)
(channel-put *from-server* (incubot-sentence inp c))
- c))
- (put .
+ c)]
+ [put .
,(lambda (sentence c)
(channel-put *from-server* #t)
- (add-to-corpus sentence c))))))
+ (add-to-corpus sentence c))])))
(thread
(lambda ()
(let loop ([c c])
View
16 lexer.rkt
@@ -22,16 +22,16 @@ exec racket --require "$0" --main -- ${1+"$@"}
(let loop ([result '()])
(eat-ws inp)
(cond
- ((eof-object? (peek-char inp))
- (reverse result))
- ((char=? #\: (peek-char inp))
+ [(eof-object? (peek-char inp))
+ (reverse result)]
+ [(char=? #\: (peek-char inp))
(begin
(read-char inp)
(if (eof-object? (peek-char inp))
result
- (loop (cons `(param . ,(regexp-match #px"[^\u0000\r\n]+" inp)) result)))))
- (else
- (loop (cons `(param . ,(regexp-match #px"[^\u0000\r\n ]+" inp)) result))))))
+ (loop (cons `(param . ,(regexp-match #px"[^\u0000\r\n]+" inp)) result))))]
+ [else
+ (loop (cons `(param . ,(regexp-match #px"[^\u0000\r\n ]+" inp)) result))])))
(check-equal? (parse-params (open-input-string ":"))
'())
@@ -56,8 +56,8 @@ exec racket --require "$0" --main -- ${1+"$@"}
(begin
(eat-ws message)
(begin0
- `((command . ,(parse-command message))
- (params . ,(parse-params message)))
+ `([command . ,(parse-command message)]
+ [params . ,(parse-params message)])
(parse-crlf message)))))]))
(check-equal?
View
22 log-parser.rkt
@@ -18,10 +18,10 @@ exec racket --require "$0" --main -- ${1+"$@"}
(define (string->utterance s)
(define (ensure-string x)
(cond
- ((string? x)
- x)
- ((bytes? x)
- (bytes->string/utf-8 x))))
+ [(string? x)
+ x]
+ [(bytes? x)
+ (bytes->string/utf-8 x)]))
(match s
;; old style: the guts are an unparsed scheme string
[(regexp #px"^([[:print:]]+) <= \":([^!]*)!([^@]*)@([^ ]*) PRIVMSG ([^:]+) :(.*)\"$"
@@ -30,7 +30,7 @@ exec racket --require "$0" --main -- ${1+"$@"}
;; new style: the guts are an s-expression
[(regexp #px"^([[:print:]]+) <= +(\\(.*\\))" (list _ timestamp raw-string))
- (match (read (open-input-string raw-string))
+ (match (read (open-input-string raw-string))
[(list (list 'prefix (regexp #rx"(.*)!(.*)@(.*)" (list _ nick _ _)))
(list 'command #"PRIVMSG")
(list 'params
@@ -62,12 +62,12 @@ exec racket --require "$0" --main -- ${1+"$@"}
#:args input-file-names
input-file-names))
(cond
- ((null? input-file-names)
+ [(null? input-file-names)
(displayln "You didn't specify any input files; running unit tests instead of parsing" (current-error-port))
- (exit (if (positive? (run-tests tests)) 1 0)))
- ((< 1 (length input-file-names))
- (error 'log-parser "I want at most one input file name; instead you gave me ~s" input-file-names))
- (else
+ (exit (if (positive? (run-tests tests)) 1 0))]
+ [(< 1 (length input-file-names))
+ (error 'log-parser "I want at most one input file name; instead you gave me ~s" input-file-names)]
+ [else
(let ([input-file-name (build-path (this-expression-source-directory) (car input-file-names))]
[output-file-name "parsed-log"])
(call-with-input-file
@@ -85,4 +85,4 @@ exec racket --require "$0" --main -- ${1+"$@"}
(write utz op)
(newline op)))))
#:exists 'truncate)))))
- (pe "done~%")))))
+ (pe "done~%"))]))
View
17 loop.rkt
@@ -18,13 +18,13 @@
#:mode 'text
#:exists 'append))))
-(for ((op (in-list (*log-ports*))))
+(for ([op (in-list (*log-ports*))])
(fprintf (current-error-port) "Whopping port ~a~%" op)
(with-handlers ([exn:fail? values])
(file-stream-buffer-mode op 'line)))
(define (log . args)
- (for ((op (in-list (*log-ports*))))
+ (for ([op (in-list (*log-ports*))])
(fprintf op "~a " (zdate #:offset 0))
(apply fprintf op args)
(newline op)))
@@ -57,16 +57,15 @@
(lambda (exn)
(printf "Oh noes! ~a!~%" (exn-message exn))
(connect-and-run server-maker (add1 consecutive-failed-connections)))])
- (let-values (((ip op)
- (server-maker)))
+ (let-values ([(ip op) (server-maker)])
(*connection-start-time* (current-seconds))
(log "Bot version ~a starting" (git-version))
- (let do-one-line ((cfc consecutive-failed-connections))
- (let ((ready-ip (sync/timeout (*bot-gives-up-after-this-many-silent-seconds*) ip))
- (retry (lambda ()
+ (let do-one-line ([cfc consecutive-failed-connections])
+ (let ([ready-ip (sync/timeout (*bot-gives-up-after-this-many-silent-seconds*) ip)]
+ [retry (lambda ()
(close-input-port ip)
(close-output-port op)
- (connect-and-run server-maker (add1 cfc)))))
+ (connect-and-run server-maker (add1 cfc)))])
(if (not ready-ip)
(begin
@@ -74,7 +73,7 @@
"Bummer: ~a seconds passed with no news from the server"
(*bot-gives-up-after-this-many-silent-seconds*))
(retry))
- (let ((line (read-line ready-ip 'return-linefeed)))
+ (let ([line (read-line ready-ip 'return-linefeed)])
(match line
[(? eof-object?)
(when retry-on-hangup?
View
2  quotes.rkt
@@ -15,7 +15,7 @@ exec racket -l errortrace --require $0 --main -- ${1+"$@"}
(let re-read ()
(fprintf (current-error-port)
"Reading quotes file~%")
- (let push-one ((all (shuffle (call-with-input-file "quotes" read))))
+ (let push-one ([all (shuffle (call-with-input-file "quotes" read))])
(if (null? all)
(re-read)
(begin
View
24 sandboxes.rkt
@@ -14,9 +14,9 @@ exec racket -l errortrace --require $0 --main -- ${1+"$@"}
(provide (rename-out [public-make-sandbox make-sandbox]))
(define (public-make-sandbox [lang '(begin (require scheme))])
(sandbox
- (parameterize ((sandbox-output 'string)
- (sandbox-error-output 'string)
- (sandbox-eval-limits '(10 20)))
+ (parameterize ([sandbox-output 'string]
+ [sandbox-error-output 'string]
+ [sandbox-eval-limits '(10 20)])
(call-with-limits 10 #f
(lambda ()
(let ([port (and (string? lang)
@@ -126,24 +126,24 @@ exec racket -l errortrace --require $0 --main -- ${1+"$@"}
(define sandboxes-tests
- (let ((*sandboxes-by-nick* (make-hash)))
+ (let ([*sandboxes-by-nick* (make-hash)])
(test-suite
"sandboxes"
(test-case
"simple get"
- (let ((s (get-sandbox-by-name *sandboxes-by-nick*"charlie")))
+ (let ([s (get-sandbox-by-name *sandboxes-by-nick*"charlie")])
(check-pred sandbox? s)
(check-equal? (sandbox-eval s "3") 3)))
(test-case
"command line args inaccessible"
- (let ((s (get-sandbox-by-name *sandboxes-by-nick* "charlie")))
- (check-pred zero? (vector-length (sandbox-eval s "(current-command-line-arguments)")) )))
+ (let ([s (get-sandbox-by-name *sandboxes-by-nick* "charlie")])
+ (check-pred zero? (vector-length (sandbox-eval s "(current-command-line-arguments)")))))
(test-case
"output"
- (let ((s (get-sandbox-by-name *sandboxes-by-nick*"charlie")))
+ (let ([s (get-sandbox-by-name *sandboxes-by-nick*"charlie")])
(sandbox-eval s "(display \"You bet!\")")
(check-equal? (sandbox-get-stdout s) "You bet!")
(sandbox-eval s "(display \"Whatever\")")
@@ -168,8 +168,8 @@ exec racket -l errortrace --require $0 --main -- ${1+"$@"}
"("
))))
- (let ((charlies-sandbox #f)
- (keiths-sandbox #f))
+ (let ([charlies-sandbox #f]
+ [keiths-sandbox #f])
(test-suite
"distinct "
@@ -184,7 +184,7 @@ exec racket -l errortrace --require $0 --main -- ${1+"$@"}
(test-case
"remembers state"
(sandbox-eval charlies-sandbox "(define x 99)")
- (let ((this-better-still-be-charlies (get-sandbox-by-name *sandboxes-by-nick*"charlie")))
+ (let ([this-better-still-be-charlies (get-sandbox-by-name *sandboxes-by-nick*"charlie")])
(check-equal? (sandbox-eval this-better-still-be-charlies
"x")
99))
@@ -200,7 +200,7 @@ exec racket -l errortrace --require $0 --main -- ${1+"$@"}
;;; (test-case
;;; "environment"
-;;; (let ((s (get-sandbox-by-name *sandboxes-by-nick* "yow")))
+;;; (let ([s (get-sandbox-by-name *sandboxes-by-nick* "yow")])
;;; (check-false (sandbox-eval s "(getenv \"HOME\")"))))
(test-case
View
59 servers.rkt
@@ -19,14 +19,14 @@ fi
scheme/port)
(define (real-server)
- (let-values (((ip op) (tcp-connect (*irc-server-hostname*) (*irc-server-port*))))
+ (let-values ([(ip op) (tcp-connect (*irc-server-hostname*)
+ (*irc-server-port*))])
(file-stream-buffer-mode op 'line)
(values ip op)))
(define (make-preloaded-server op)
(lambda ()
- (values (let-values (((ip op)
- (make-pipe)))
+ (values (let-values ([(ip op) (make-pipe)])
(thread
(lambda ()
(define (meh str)
@@ -108,7 +108,7 @@ fi
,(format ":n!n@n PRIVMSG #not-emacs :,...")
,(format ":n!n@n PRIVMSG #c :~a:~a" (unbox *my-nick*) "lookboynospaces")
,(format ":n!n@n PRIVMSG #c :~a:" (unbox *my-nick*) )
- ,@(for/list ((action (in-list (list "action" "invite" "join" "kick" "kick2" "mode" "nick" "nick2" "notice" "notice2" "part" "quit" "topic"))))
+ ,@(for/list ([action (in-list (list "action" "invite" "join" "kick" "kick2" "mode" "nick" "nick2" "notice" "notice2" "part" "quit" "topic"))])
(c (format "seen ~a" action)))
":niven.freenode.net 001 rudybot :Welcome to the freenode IRC Network rudybot"
@@ -118,14 +118,14 @@ fi
,@(apply
append
- (for/list ((expr (in-list '((+ 2 1)
+ (for/list ([expr (in-list '((+ 2 1)
(begin (display (+ 2 1)) (newline))
(let loop ()
(printf "Yaa!!")
(loop))
(require srfi/1)
(make-list 100000)
- (apply values (make-list 100000))))))
+ (apply values (make-list 100000))))])
(list
(c (format "eval ~s" expr))
(p (format "eval ~s" expr)))))
@@ -148,15 +148,14 @@ fi
op)))
(define (make-log-replaying-ip-port log-file-name (max-lines 'all))
- (let-values (((ip op)
- (make-pipe)))
+ (let-values ([(ip op) (make-pipe)])
(thread
(lambda ()
(call-with-input-file log-file-name
(lambda (ip)
(let/ec return
- (for ((line (in-lines ip))
- (lines-handled (in-naturals)))
+ (for ([line (in-lines ip)]
+ [lines-handled (in-naturals)])
(when (equal? lines-handled max-lines)
(return))
(match line
@@ -188,22 +187,19 @@ fi
(define (make-random-server)
(define (random-bytes [length 200])
- (let ((r (make-bytes length)))
- (for ((i (in-range length)))
+ (let ([r (make-bytes length)])
+ (for ([i (in-range length)])
(let new-byte ()
- (let ((b (random 256)))
+ (let ([b (random 256)])
(case b
- ((10 13)
- (new-byte))
- (else
- (bytes-set! r i b))))))
+ [(10 13) (new-byte)]
+ [else (bytes-set! r i b)]))))
r))
- (let-values (((ip op)
- (make-pipe)))
+ (let-values ([(ip op) (make-pipe)])
(thread
(lambda ()
- (let loop ((lines-emitted 0))
+ (let loop ([lines-emitted 0])
(when (< lines-emitted 200)
(display #":ow!ow@ow PRIVMSG #ow :" op)
(display (random-bytes) op)
@@ -215,15 +211,14 @@ fi
(define (make-hanging-up-server)
(lambda ()
- (let-values (((ip op)
- (make-pipe)))
+ (let-values ([(ip op) (make-pipe)])
(thread
(lambda ()
- (for ((line (in-list '("NOTICE AUTH :*** Looking up your hostname..."
+ (for ([line (in-list '("NOTICE AUTH :*** Looking up your hostname..."
"NOTICE AUTH :*** Found your hostname, welcome back"
"NOTICE AUTH :*** Checking ident"
"NOTICE AUTH :*** No identd (auth) response"
- "ERROR :Closing Link: 127.0.0.1 (Connection Timed Out)"))))
+ "ERROR :Closing Link: 127.0.0.1 (Connection Timed Out)"))])
(fprintf op "~a\r~%" line))
(sleep 1)
@@ -233,8 +228,8 @@ fi
(define (replay-main . args)
- (parameterize ((*bot-gives-up-after-this-many-silent-seconds* 1/4)
- (*log-ports* (list (current-error-port))))
+ (parameterize ([*bot-gives-up-after-this-many-silent-seconds* 1/4]
+ [*log-ports* (list (current-error-port))])
(log "Main starting.")
(connect-and-run
(make-log-replaying-server "big-log")
@@ -252,27 +247,27 @@ fi
(define (localhost-main . args)
(log "Main starting: ~a" (git-version))
- (parameterize ((*irc-server-hostname* "localhost"))
+ (parameterize ([*irc-server-hostname* "localhost"])
(connect-and-run real-server)))
(define (flaky-main . args)
- (parameterize ((*bot-gives-up-after-this-many-silent-seconds* 1/4)
- (*log-ports* (list (current-error-port))))
+ (parameterize ([*bot-gives-up-after-this-many-silent-seconds* 1/4]
+ [*log-ports* (list (current-error-port))])
(random-seed 0)
(connect-and-run
(make-flaky-server "big-log")
#:retry-on-hangup? #t)))
(define (random-main . args)
- (parameterize ((*bot-gives-up-after-this-many-silent-seconds* 1/4)
- (*log-ports* (list (current-error-port))))
+ (parameterize ([*bot-gives-up-after-this-many-silent-seconds* 1/4]
+ [*log-ports* (list (current-error-port))])
(random-seed 0)
(connect-and-run
make-random-server
#:retry-on-hangup? #f)))
(define (hanging-up-main . args)
- (parameterize ((*log-ports* (list (current-error-port))))
+ (parameterize ([*log-ports* (list (current-error-port))])
(connect-and-run
(make-hanging-up-server))))
View
32 sighting-server.rkt
@@ -54,17 +54,17 @@
(request-client-ip initial-request)
(url->string (request-uri initial-request)))
- (let ((requested-sort-column
- (let ((datum (cond
- ((assq 'column (request-bindings initial-request)) => cdr)
- (else 'who))))
+ (let ([requested-sort-column
+ (let ([datum (cond
+ [(assq 'column (request-bindings initial-request)) => cdr]
+ [else 'who])])
(cond
- ((string? datum) (string->symbol datum))
- (else datum)))))
+ [(string? datum) (string->symbol datum)]
+ [else datum]))])
(define generate-response
(lambda ()
- (let ((s (*sightings*)))
+ (let ([s (*sightings*)])
`(html
(body
(h3
@@ -74,7 +74,7 @@
(zdate (file-or-directory-modify-seconds *sightings-file-path*))
requested-sort-column))
- (table ((rules "all"))
+ (table ([rules "all"])
(tr
(form ([method "get"]
@@ -93,23 +93,23 @@
s
(lambda (p1 p2)
(case requested-sort-column
- ((who)
+ [(who)
(string-ci<? (car p1)
- (car p2)))
- ((where)
+ (car p2))]
+ [(where)
(string-ci<? (sighting-where (cdr p1))
- (sighting-where (cdr p2))))
+ (sighting-where (cdr p2)))]
;; newest first
- ((when)
+ [(when)
(> (sighting-when (cdr p1))
- (sighting-when (cdr p2))))
+ (sighting-when (cdr p2)))]
- (else
+ [else
(string-ci<? (string-join
(sighting-words (cdr p1)) " ")
(string-join
- (sighting-words (cdr p2)) " ")))))))))))))
+ (sighting-words (cdr p2)) " "))]))))))))))
(with-errors-to-browser send/finish generate-response))
)
View
31 sighting-test.rkt
@@ -16,14 +16,14 @@ exec racket --require "$0" --main -- ${1+"$@"}
"sighting-test"
(test-case
"yow"
- (let ((s (make-sighting "1" "2" 3 #f (list "hey" "you"))))
+ (let ([s (make-sighting "1" "2" 3 #f (list "hey" "you"))])
(note-sighting s)
(check-not-false (member s (lookup-sightings "1")))
(check-equal? (lookup-sightings "snorkuplexity") '())))
(test-case
"persistent"
- (parameterize ((*userinfo-database-directory-name* "persistent-test.db"))
- (let ((stuff (map make-sighting
+ (parameterize ([*userinfo-database-directory-name* "persistent-test.db"])
+ (let ([stuff (map make-sighting
(list "fred" "paul" "mary" "fred_")
(list "2" "3" "4" "5")
(list 9 8 7 6)
@@ -31,8 +31,8 @@ exec racket --require "$0" --main -- ${1+"$@"}
(list (list "znork?")
(list "I" "am" "NOT" "dead")
(list "I" "am" "Jesus'" "mom")
- (list "I'm" "fred" "with" "a" "trailing" "underscore")))))
- (let ((writing? (not (directory-exists? (*userinfo-database-directory-name*)))))
+ (list "I'm" "fred" "with" "a" "trailing" "underscore")))])
+ (let ([writing? (not (directory-exists? (*userinfo-database-directory-name*)))])
;; if the db doesn't exist, note some stuff.
;; if the db does exist, check for what we noted.
(if writing?
@@ -41,33 +41,32 @@ exec racket --require "$0" --main -- ${1+"$@"}
(printf "Reading test data from ~a~%"
(*userinfo-database-directory-name*)))
- (for ((s (in-list stuff)))
+ (for ([s (in-list stuff)])
(if writing?
(note-sighting s)
(check-not-false (member s (lookup-sightings (canonicalize-nick (sighting-who s)))))))))))
(test-case
"case-insensitive"
- (let ((s (make-sighting "BOB" "2" 3 #f (list "hey" "you"))))
+ (let ([s (make-sighting "BOB" "2" 3 #f (list "hey" "you"))])
(note-sighting s)
- (let ((looked-up-uc (lookup-sightings "BOB"))
- (looked-up-lc (lookup-sightings "bob")))
+ (let ([looked-up-uc (lookup-sightings "BOB")]
+ [looked-up-lc (lookup-sightings "bob")])
(check-equal? looked-up-lc looked-up-uc)))
- (let ((s (make-sighting "bob" "2" 3 #f (list "hey" "you"))))
+ (let ([s (make-sighting "bob" "2" 3 #f (list "hey" "you"))])
(note-sighting s)
- (let ((looked-up-lc (lookup-sightings "bob"))
- (looked-up-uc (lookup-sightings "BOB")))
+ (let ([looked-up-lc (lookup-sightings "bob")]
+ [looked-up-uc (lookup-sightings "BOB")])
(check-equal? looked-up-uc looked-up-lc)))
(delete-directory/files (build-path (*userinfo-database-directory-name*) "b" "bob"))
- (let ((s (make-sighting "BOB" "2" 3 #f (list "hey" "you"))))
+ (let ([s (make-sighting "BOB" "2" 3 #f (list "hey" "you"))])
(note-sighting s)
- (let ((looked-up-lc (lookup-sightings "bob"))
- (looked-up-uc (lookup-sightings "BOB")))
+ (let ([looked-up-lc (lookup-sightings "bob")]
+ [looked-up-uc (lookup-sightings "BOB")])
(check-equal? looked-up-uc looked-up-lc))))))
(define (main . args)
(exit (test/text-ui sighting-tests 'verbose)))
(provide (all-defined-out))
-
View
44 spelled-out-time.rkt
@@ -10,39 +10,39 @@ exec racket -l errortrace --require $0 --main -- ${1+"$@"}
(planet schematics/schemeunit:3/text-ui))
(define (seconds->english secs)
- (let loop ((units secs)
- (divisors '((second . 60)
+ (let loop ([units secs]
+ [divisors '((second . 60)
(minute . 60)
(hour . 24)
(day . 7)
(week . 52)
- (year . 100)))
- (accum '()))
+ (year . 100))]
+ [accum '()])
(cond
- ((zero? units)
+ [(zero? units)
(if (null? accum)
'((second . 0))
- accum))
- ((null? divisors)
- (cons `(century . ,units) accum))
- (else
- (let ((d (car divisors)))
- (let-values (((q r) (quotient/remainder units (cdr d))))
+ accum)]
+ [(null? divisors)
+ (cons `(century . ,units) accum)]
+ [else
+ (let ([d (car divisors)])
+ (let-values ([(q r) (quotient/remainder units (cdr d))])
(loop
q
(cdr divisors)
- (cons (cons (car d) r) accum))))))))
+ (cons (cons (car d) r) accum))))])))
(define (number->english/plural n unit-name)
(define (y->ie n unit-name)
(cond
- ((equal? 1 n)
- unit-name)
- ((equal? unit-name "century")
- "centurie")
- (else unit-name)))
+ [(equal? 1 n)
+ unit-name]
+ [(equal? unit-name "century")
+ "centurie"]
+ [else unit-name]))
(string-append (number->english n)
" "
@@ -52,16 +52,16 @@ exec racket -l errortrace --require $0 --main -- ${1+"$@"}
"s")))
(define (safe-take lst pos)
- (let ((pos (min pos (length lst))))
+ (let ([pos (min pos (length lst))])
(take lst pos)))
(define (spelled-out-time secs)
- (let* ((result (safe-take (seconds->english secs) 1))
- (final (list (car result)))
- (final (if (and (< 1 (length result))
+ (let* ([result (safe-take (seconds->english secs) 1)]
+ [final (list (car result))]
+ [final (if (and (< 1 (length result))
(zero? (cdr (second result))))
final
- (append final (cdr result)))))
+ (append final (cdr result)))])
(string-join
(map (lambda (p)
(number->english/plural
View
4 tinyurl.rkt
@@ -22,8 +22,8 @@ exec racket -l errortrace --require "$0" --main -- ${1+"$@"}
(post-pure-port
create-url
(string->bytes/utf-8
- (parameterize ((current-alist-separator-mode 'amp))
- (alist->form-urlencoded `((url . ,url)))))
+ (parameterize ([current-alist-separator-mode 'amp])
+ (alist->form-urlencoded `([url . ,url]))))
(list "Content-Type: application/x-www-form-urlencoded")))
reader))
View
16 update-sightings.rkt
@@ -21,8 +21,8 @@ exec racket --require "$0" --main -- ${1+"$@"}
(reverse
(fold-files
(lambda (path flavor accum)
- (let* ((rel (find-relative-path old-sightings-root path))
- (depth (length (explode-path rel))))
+ (let* ([rel (find-relative-path old-sightings-root path)]
+ [depth (length (explode-path rel))])
(if (and (= 2 depth)
(directory-exists? path))
(cons path accum)
@@ -32,16 +32,16 @@ exec racket --require "$0" --main -- ${1+"$@"}
(define (upgrade! nick-dir)
(fprintf (current-error-port) "~a ... ~%" nick-dir)
- (let* ((files
+ (let* ([files
(map (lambda (rel)
(build-path nick-dir rel))
- (directory-list nick-dir)))
- (structs (for/list ([f files])
- (call-with-input-file f read))))
+ (directory-list nick-dir))]
+ [structs (for/list ([f files])
+ (call-with-input-file f read))])
(delete-directory/files nick-dir)
- (let ((nick-file (regexp-replace #rx"/$"
+ (let ([nick-file (regexp-replace #rx"/$"
(path->string (simplify-path nick-dir))
- "")))
+ "")])
(call-with-output-file nick-file
(lambda (op)
(pretty-print (list (cons 'sightings structs)) op)
View
10 userinfo.rkt
@@ -115,11 +115,11 @@ exec racket --require "$0" --main -- ${1+"$@"}
(provide *userinfo-database-directory-name*)
(provide/contract
- [struct sighting ((who string?)
- (where string?)
- (when natural-number/c)
- (action? (or/c string? not))
- (words (listof string?)))]
+ [struct sighting ([who string?]
+ [where string?]
+ [when natural-number/c]
+ [action? (or/c string? not)]
+ [words (listof string?)])]
[lookup-sightings (-> string? (listof sighting?))]
[note-sighting (-> sighting? void?)]
[canonicalize-nick (-> string? string?)]
View
18 xlate.rkt
@@ -107,9 +107,9 @@ exec racket -l errortrace --require "$0" --main -- ${1+"$@"}
(make-url
"http" #f "ajax.googleapis.com" #f #t
(map ((curryr make-path/param) '()) (list "ajax" "services" "language" "translate"))
- `((v . "1.0")
- (q . ,text)
- (langpair . ,(format "~a|~a" from to))) #f)
+ `([v . "1.0"]
+ [q . ,text]
+ [langpair . ,(format "~a|~a" from to)]) #f)
get-pure-port
read-json))
@@ -127,19 +127,19 @@ exec racket -l errortrace --require "$0" --main -- ${1+"$@"}
(let* ([stuff (snag text from to)]
[responseStatus (hash-ref stuff 'responseStatus)])
(cond
- ((equal? responseStatus 200)
+ [(equal? responseStatus 200)
(replace-html-entities
(hash-ref
(hash-ref
stuff
'responseData)
- 'translatedText)))
- ((and (equal? responseStatus 400)
+ 'translatedText))]
+ [(and (equal? responseStatus 400)
(regexp-match #rx"invalid.*pair" (hash-ref stuff 'responseDetails)))
(format "~a: see http://code.google.com/apis/language/translate/v1/reference.html#LangNameArray"
- (hash-ref stuff 'responseDetails)))
- (else
- (hash-ref stuff 'responseDetails)))))
+ (hash-ref stuff 'responseDetails))]
+ [else
+ (hash-ref stuff 'responseDetails)])))
(define t8 xlate)
Please sign in to comment.
Something went wrong with that request. Please try again.