move functions into readability

pull/9/head
Matthew Butterick 10 years ago
parent ca84dad697
commit 99699d69f4

@ -314,3 +314,28 @@
; (check-equal? (splitf-at* '("foo" " " "bar" "\n" "\n" "ino") whitespace?) '(("foo")("bar")("ino")))
(check-equal? (splitf-at* '(1 2 3 4 5 6) even?) '((1)(3)(5))))
;; convert a bytecount into a string
(define/contract (bytecount->string bytecount)
(integer? . -> . string?)
(define (format-with-threshold threshold suffix)
;; upconvert by factor of 100 to get two digits after decimal
(format "~a ~a" (exact->inexact (/ (round ((* bytecount 100) . / . threshold)) 100)) suffix))
(define threshold-kilobyte 1000)
(define threshold-megabyte (threshold-kilobyte . * . threshold-kilobyte))
(define threshold-gigabyte (threshold-megabyte . * . threshold-kilobyte))
(define threshold-terabyte (threshold-gigabyte . * . threshold-kilobyte))
(cond
[(bytecount . >= . threshold-terabyte) (format-with-threshold threshold-terabyte "TB")]
[(bytecount . >= . threshold-gigabyte) (format-with-threshold threshold-gigabyte "GB")]
[(bytecount . >= . threshold-megabyte) (format-with-threshold threshold-megabyte "MB")]
[(bytecount . >= . threshold-kilobyte) (format-with-threshold threshold-kilobyte "KB")]
[else (format "~a bytes" bytecount)]))
;; for use inside quasiquote
;; instead of ,(when ...) use ,@(when/splice ...)
;; to avoid voids
(define-syntax-rule (when/splice test body) (if test (list body) '()))

@ -4,6 +4,7 @@
(require net/url)
(require web-server/http/request-structs)
(require web-server/http/response-structs)
(require 2htdp/image)
(require "world.rkt" "render.rkt" "readability.rkt" "predicates.rkt" "debug.rkt")
(module+ test (require rackunit))
@ -79,27 +80,7 @@
(xexpr? . -> . tagged-xexpr?)
(body-wrapper `(tt ,x)))
(define/contract (bytecount->string bytecount)
(integer? . -> . string?)
(define (format-with-threshold threshold suffix)
;; upconvert by factor of 100 to get two digits after decimal
(format "~a ~a" (exact->inexact (/ (round ((* bytecount 100) . / . threshold)) 100)) suffix))
(define threshold-gigabyte 1000000000)
(define threshold-megabyte (threshold-gigabyte . / . 1000))
(define threshold-kilobyte (threshold-megabyte . / . 1000))
(cond
[(bytecount . > . threshold-gigabyte) (format-with-threshold threshold-gigabyte "GB")]
[(bytecount . > . threshold-megabyte) (format-with-threshold threshold-megabyte "MB")]
[(bytecount . > . threshold-kilobyte) (format-with-threshold threshold-kilobyte "KB")]
[else (format "~a bytes" bytecount)]))
(define-syntax-rule (when/splice test body) (if test (list body) '()))
(require 2htdp/image)
(define (handle-image-path p)
(pathish? . -> . xexpr?)
(define path (->complete-path p))
@ -115,7 +96,6 @@
(a ((href ,img-url)) (img ((style "width:100%")(src ,img-url))))))
(define/contract (make-binary-info-page p)
(pathish? . -> . xexpr?)
(define path (->complete-path p))

Loading…
Cancel
Save