From b180a220febfbbb57f1143dd06dda1c1bc882bfb Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Fri, 14 Feb 2014 12:48:43 -0800
Subject: [PATCH] Initial commit of source files

---
 coerce.rkt              | 90 ++++++++++++++++++++++++++++++++++++++
 container.rkt           | 67 +++++++++++++++++++++++++++++
 debug.rkt               | 17 ++++++++
 info.rkt                |  3 ++
 len.rkt                 | 21 +++++++++
 list.rkt                | 31 ++++++++++++++
 main.rkt                | 20 +++++++++
 misc.rkt                | 27 ++++++++++++
 scribblings/sugar.scrbl | 36 ++++++++++++++++
 string.rkt              | 24 +++++++++++
 tests.rkt               | 95 +++++++++++++++++++++++++++++++++++++++++
 11 files changed, 431 insertions(+)
 create mode 100644 coerce.rkt
 create mode 100644 container.rkt
 create mode 100644 debug.rkt
 create mode 100644 info.rkt
 create mode 100644 len.rkt
 create mode 100644 list.rkt
 create mode 100644 main.rkt
 create mode 100644 misc.rkt
 create mode 100644 scribblings/sugar.scrbl
 create mode 100644 string.rkt
 create mode 100644 tests.rkt

diff --git a/coerce.rkt b/coerce.rkt
new file mode 100644
index 0000000..35134a6
--- /dev/null
+++ b/coerce.rkt
@@ -0,0 +1,90 @@
+#lang racket/base
+(require racket/contract net/url xml racket/set)
+(module+ test (require rackunit))
+(require "len.rkt")
+
+(provide ->int ->string ->list ->boolean ->symbol)
+
+;; general way of coercing to integer
+(define/contract (->int x)
+  (any/c . -> . integer?)
+  (cond
+    [(integer? x) x]
+    [(real? x) (floor x)]
+    [(and (string? x) (> (len x) 0)) (->int (string->number x))]
+    [(symbol? x) (->int (->string x))]
+    [(char? x) (char->integer x)]
+    [else (or (len x) (error "Can't convert to integer:" x))])) ; try len before giving up
+
+
+;; general way of coercing to string
+(define/contract (->string x)
+  (any/c . -> . string?)
+  (cond 
+    [(string? x) x]
+    [(equal? '() x) ""]
+    [(symbol? x) (symbol->string x)]
+    [(number? x) (number->string x)]
+    [(url? x) (->string (->path x))] ; todo: a url is more than just a path-string ... it has character encoding issues
+    [(path? x) (path->string x)]
+    [(char? x) (format "~a" x)]
+    [(xexpr? x) (xexpr->string x)] ; put this last so other xexprish things don't get caught
+    [else (error (format "Can't make ~a into string" x))]))
+
+
+;; general way of coercing to symbol
+(define (->symbol thing)
+  ; todo: on bad input, it will pop a string error rather than symbol error
+  (string->symbol (->string thing))) 
+
+;; general way of coercing to path
+(define/contract (->path thing)
+  (any/c . -> . path?)
+  ; todo: on bad input, it will pop a string error rather than path error
+  (cond 
+    [(url? thing) (apply build-path (map path/param-path (url-path thing)))]
+    [else (string->path (->string thing))]))
+
+
+;; general way of coercing to url
+(define/contract (->url thing)
+  (any/c . -> . url?)
+  ; todo: on bad input, it will pop a string error rather than url error
+  (string->url (->string thing)))
+
+(define (->complete-path thing)
+  (path->complete-path (->path thing)))
+
+
+;; general way of coercing to a list
+(define/contract (->list x)
+  (any/c . -> . list?)
+  (cond 
+    [(list? x) x]
+    [(vector? x) (vector->list x)]
+    [(set? x) (set->list x)]
+    [else (list x)])) 
+
+
+
+;; general way of coercing to vector
+(define (->vector x)
+  (any/c . -> . vector?)
+  ; todo: on bad input, it will pop a list error rather than vector error
+  (cond
+    [(vector? x) x]
+    [else (list->vector (->list x))]))
+
+
+
+;; general way of coercing to boolean
+(define/contract (->boolean x)
+  (any/c . -> . boolean?)
+  ;; in Racket, everything but #f is true
+  (if x #t #f))
+
+
+
+
+
+
diff --git a/container.rkt b/container.rkt
new file mode 100644
index 0000000..788908f
--- /dev/null
+++ b/container.rkt
@@ -0,0 +1,67 @@
+#lang racket/base
+(require racket/contract racket/vector racket/list)
+(require "coerce.rkt" "len.rkt")
+
+(provide get in?)
+
+
+(define/contract (sliceable-container? x)
+  (any/c . -> . boolean?)
+  (ormap (λ(proc) (proc x)) (list list? string? symbol? vector?)))
+
+(define/contract (gettable-container? x)
+  (any/c . -> . boolean?)
+  (ormap (λ(proc) (proc x)) (list sliceable-container? hash?))) 
+
+
+
+;; general way of fetching an item from a container
+(define/contract (get container start [end #f])
+  ((gettable-container? any/c) ((λ(i)(or (integer? i) (and (symbol? i) (equal? i 'end))))) 
+                               . ->* . any/c)
+  
+  (set! end
+        (if (sliceable-container? container)
+            (cond 
+              ;; treat negative lengths as offset from end (Python style)
+              [(and (integer? end) (< end 0)) (+ (len container) end)]
+              ;; 'end slices to the end
+              [(equal? end 'end) (len container)]
+              ;; default to slice length of 1 (i.e, single-item retrieval)
+              [(equal? end #f) (add1 start)]
+              [else end])
+            end))
+  
+  (define result (cond
+                   ;; for sliceable containers, make a slice
+                   [(list? container) (for/list ([i (range start end)]) 
+                                        (list-ref container i))]
+                   [(vector? container) (for/vector ([i (range start end)])
+                                          (vector-ref container i))] 
+                   [(string? container) (substring container start end)]
+                   [(symbol? container) (->symbol (get (->string container) start end))] 
+                   ;; for hash, just get item
+                   [(hash? container) (hash-ref container start)]
+                   [else #f]))
+  
+  ;; don't return single-item results inside a list
+  (if (and (sliceable-container? container) (= (len result) 1))
+      (car (->list result))
+      result))
+
+
+
+
+;; general way of testing for membership (à la Python 'in')
+;; put item as first arg so function can use infix notation
+;; (item . in . container)
+(define/contract (in? item container)
+  (any/c any/c . -> . boolean?)
+  (->boolean (cond
+               [(list? container) (member item container)] ; returns #f or sublist beginning with item
+               [(vector? container) (vector-member item container)] ; returns #f or zero-based item index
+               [(hash? container) 
+                (and (hash-has-key? container item) (get container item))] ; returns #f or hash value
+               [(string? container) ((->string item) . in? . (map ->string (string->list container)))] ; returns #f or substring beginning with item
+               [(symbol? container) ((->string item) . in? . (->string container))] ; returns #f or subsymbol (?!) beginning with item
+               [else #f])))
\ No newline at end of file
diff --git a/debug.rkt b/debug.rkt
new file mode 100644
index 0000000..4c4e226
--- /dev/null
+++ b/debug.rkt
@@ -0,0 +1,17 @@
+#lang racket/base
+
+(provide report describe)
+
+; report the current value of the variable, then return it
+(define-syntax-rule (report var)
+  (begin 
+    (basic-message 'var "=" var) 
+    var))
+
+
+(require (prefix-in williams: (planet williams/describe/describe)))
+
+(define (describe x)
+  (parameterize ([current-output-port (current-error-port)])
+    (williams:describe x))
+  x)
\ No newline at end of file
diff --git a/info.rkt b/info.rkt
new file mode 100644
index 0000000..e503bab
--- /dev/null
+++ b/info.rkt
@@ -0,0 +1,3 @@
+#lang info
+(define collection "sugar")
+(define scribblings '(("scribblings/sugar.scrbl" ())))
\ No newline at end of file
diff --git a/len.rkt b/len.rkt
new file mode 100644
index 0000000..12aa54b
--- /dev/null
+++ b/len.rkt
@@ -0,0 +1,21 @@
+#lang racket/base
+(require racket/contract racket/set)
+
+(provide len)
+
+(define/contract (has-length? x)
+  (any/c . -> . boolean?)
+  (ormap (λ(proc) (proc x)) (list list? string? symbol? vector? hash? set?)))
+
+;; general way of asking for length
+(define/contract (len x)
+  (any/c . -> . (or/c integer? #f))
+  (cond
+    [(list? x) (length x)]
+    [(string? x) (string-length x)]
+    [(symbol? x) (len (symbol->string x))]
+    [(vector? x) (len (vector->list x))]
+    [(hash? x) (len (hash-keys x))]
+    [(set? x) (len (set->list x))]
+    [(integer? x) (len (number->string x))]
+    [else #f]))
\ No newline at end of file
diff --git a/list.rkt b/list.rkt
new file mode 100644
index 0000000..e08e45e
--- /dev/null
+++ b/list.rkt
@@ -0,0 +1,31 @@
+#lang racket/base
+(require racket/contract racket/list)
+
+(provide trim splitf-at*)
+
+;; trim from beginning & end of list
+(define (trim items test-proc)
+  (list? procedure? . -> . list?)
+  (dropf-right (dropf items test-proc) test-proc))
+
+
+;; split list into list of sublists using test-proc
+(define/contract (splitf-at* xs split-test)
+    
+  ;; todo: better error message when split-test is not a predicate
+  (list? predicate/c . -> . (listof list?))
+  (define (&splitf-at* xs [acc '()]) ; use acc for tail recursion
+    (if (empty? xs) 
+        ;; reverse because accumulation is happening backward 
+        ;; (because I'm using cons to push latest match onto front of list)
+        (reverse acc)
+        (let-values ([(item rest) 
+                      ;; drop matching elements from front
+                      ;; then split on nonmatching 
+                      ;; = nonmatching item + other elements (which will start with matching)
+                      (splitf-at (dropf xs split-test) (compose1 not split-test))])
+          ;; recurse, and store new item in accumulator
+          (&splitf-at* rest (cons item acc)))))
+  
+  ;; trim off elements matching split-test
+  (&splitf-at* (trim xs split-test)))
\ No newline at end of file
diff --git a/main.rkt b/main.rkt
new file mode 100644
index 0000000..93eb9c8
--- /dev/null
+++ b/main.rkt
@@ -0,0 +1,20 @@
+#lang racket/base
+
+(require
+  "coerce.rkt"
+  "container.rkt"
+  "debug.rkt"
+  "list.rkt"
+  "misc.rkt"
+  "string.rkt"
+  "len.rkt")
+
+(provide 
+ (all-from-out
+  "coerce.rkt"
+  "container.rkt"
+  "debug.rkt"
+  "list.rkt"
+  "misc.rkt"
+  "string.rkt"
+  "len.rkt"))
\ No newline at end of file
diff --git a/misc.rkt b/misc.rkt
new file mode 100644
index 0000000..e1fbe6e
--- /dev/null
+++ b/misc.rkt
@@ -0,0 +1,27 @@
+#lang racket/base
+(require racket/contract)
+
+;; 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) '()))
\ No newline at end of file
diff --git a/scribblings/sugar.scrbl b/scribblings/sugar.scrbl
new file mode 100644
index 0000000..8739cb3
--- /dev/null
+++ b/scribblings/sugar.scrbl
@@ -0,0 +1,36 @@
+#lang scribble/manual
+
+@(require scribble/eval (for-label racket "../main.rkt"))
+
+@(define my-eval (make-base-eval))
+@(my-eval `(require sugar))
+
+
+@title{Sugar}
+
+@author[(author+email "Matthew Butterick" "mb@mbtype.com")]
+
+A collection of little functions that help make Racket code more readable.
+
+@section{Installation & updates}
+
+At the command line:
+@verbatim{raco pkg install sugar}
+
+After that, you can update the package from the command line:
+@verbatim{raco pkg update sugar}
+
+
+@section{Interface}
+
+@defmodule[sugar]
+
+Hello sugar.
+
+
+@section{License & source code}
+
+This module is licensed under the LGPL.
+
+Source repository at @link["http://github.com/mbutterick/sugar"]{http://github.com/mbutterick/sugar}. Suggestions & corrections welcome.
+
diff --git a/string.rkt b/string.rkt
new file mode 100644
index 0000000..b4d086b
--- /dev/null
+++ b/string.rkt
@@ -0,0 +1,24 @@
+#lang racket/base
+(require racket/contract)
+(require "coerce.rkt" "container.rkt" "len.rkt")
+
+(provide starts-with? ends-with?)
+
+;; stringish: data type that can be trivially converted to string
+;; todo: merge this with pathish
+(define/contract (stringish? x)
+  (any/c . -> . boolean?)
+  (with-handlers ([exn:fail? (λ(e) #f)])
+    (->boolean (->string x))))
+
+;; python-style string testers
+(define/contract (starts-with? str starter)
+  (stringish? stringish? . -> . boolean?)
+  (let ([str (->string str)]
+        [starter (->string starter)])
+    (and (<= (len starter) (len str)) (equal? (get str 0 (len starter)) starter))))
+
+
+(define/contract (ends-with? str ender)
+  (string? string? . -> . boolean?)
+  (and (<= (len ender) (len str)) (equal? (get str (- (len str) (len ender)) 'end) ender)))
\ No newline at end of file
diff --git a/tests.rkt b/tests.rkt
new file mode 100644
index 0000000..5dde89f
--- /dev/null
+++ b/tests.rkt
@@ -0,0 +1,95 @@
+#lang racket/base
+
+(require rackunit net/url racket/set)
+(require "coerce.rkt" "container.rkt" "string.rkt" "list.rkt")
+
+(check-equal? (->string "foo") "foo")
+(check-equal? (->string '()) "")
+(check-equal? (->string 'foo) "foo")
+(check-equal? (->string 123) "123")
+(check-equal? (->string (string->url "foo/bar.html")) "foo/bar.html")
+(define file-name-as-text "foo.txt")
+(check-equal? (->string (string->path file-name-as-text)) file-name-as-text)
+(check-equal? (->string #\¶) "¶")
+(check-equal? (->string '(foo "bar")) "<foo>bar</foo>")
+
+
+
+(check-equal? (->path "foo") (string->path "foo"))
+(check-equal? (->path 'foo) (string->path "foo"))
+(check-equal? (->path 123) (string->path "123"))
+(check-equal? (->path (string->url "foo/bar.html")) (string->path "foo/bar.html"))
+
+(check-equal? (->list '(1 2 3)) '(1 2 3))
+(check-equal? (->list (list->vector '(1 2 3))) '(1 2 3))
+(check-equal? (->list (set 1 2 3)) '(3 2 1))
+(check-equal? (->list "foo") (list "foo"))
+
+(check-true (->boolean #t))
+(check-false (->boolean #f))
+(check-true (->boolean "#f")) 
+(check-true (->boolean "foo"))
+(check-true (->boolean '()))
+(check-true (->boolean '(1 2 3)))
+
+
+(check-equal? (len '(1 2 3)) 3)
+(check-not-equal? (len '(1 2)) 3) ; len 2
+(check-equal? (len "foo") 3)
+(check-not-equal? (len "fo") 3) ; len 2
+(check-equal? (len 'foo) 3)
+(check-not-equal? (len 'fo) 3) ; len 2
+(check-equal? (len (list->vector '(1 2 3))) 3)
+(check-not-equal? (len (list->vector '(1 2))) 3) ; len 2
+(check-equal? (len (set 1 2 3)) 3)
+(check-not-equal? (len (set 1 2)) 3) ; len 2
+(check-equal? (len (make-hash '((a . 1) (b . 2) (c . 3)))) 3)
+(check-not-equal? (len (make-hash '((a . 1) (b . 2)))) 3) ; len 2
+
+
+(check-equal? (get '(0 1 2 3 4 5) 2) 2)
+(check-equal? (get `(0 1 ,(list 2) 3 4 5) 2) (list 2))
+(check-equal? (get '(0 1 2 3 4 5) 0 2) '(0 1))
+(check-equal? (get '(0 1 2 3 4 5) 2 -1) '(2 3 4))
+(check-equal? (get '(0 1 2 3 4 5) 2 'end) '(2 3 4 5))
+(check-equal? (get (list->vector '(0 1 2 3 4 5)) 2) 2)
+(check-equal? (get (list->vector'(0 1 2 3 4 5)) 0 2) (list->vector '(0 1)))
+(check-equal? (get (list->vector'(0 1 2 3 4 5)) 2 -1) (list->vector '(2 3 4)))
+(check-equal? (get (list->vector'(0 1 2 3 4 5)) 2 'end) (list->vector '(2 3 4 5)))
+(check-equal? (get "purple" 2) "r")
+(check-equal? (get "purple" 0 2) "pu")
+(check-equal? (get "purple" 2 -1) "rpl")
+(check-equal? (get "purple" 2 'end) "rple")
+(check-equal? (get 'purple 2) 'r)
+(check-equal? (get 'purple 0 2) 'pu)
+(check-equal? (get 'purple 2 -1) 'rpl)
+(check-equal? (get 'purple 2 'end) 'rple)
+(check-equal? (get (make-hash `((a . ,(list 1)) (b . ,(list 2)) (c  . ,(list 3)))) 'a) (list 1))
+
+
+(check-true (2 . in? . '(1 2 3)))
+(check-false (4 . in? . '(1 2 3)))
+(check-true (2 . in? . (list->vector '(1 2 3))))
+(check-false (4 . in? . (list->vector '(1 2 3))))
+(check-true ('a . in? . (make-hash '((a . 1) (b . 2) (c  . 3)))))
+(check-false ('x . in? . (make-hash '((a . 1) (b . 2) (c  . 3)))))
+(check-true ("o" . in? . "foobar"))
+(check-false ("z" . in? . "foobar"))
+(check-true ('o . in? . 'foobar))
+(check-false ('z . in? . 'foobar))
+(check-false ("F" . in? . #\F))
+
+
+(check-true ("foobar" . starts-with? . "foo"))
+(check-true ("foobar" . starts-with? . "f"))
+(check-true ("foobar" . starts-with? . "foobar"))
+(check-false ("foobar" . starts-with? . "bar"))
+(check-true ("foobar" . ends-with? . "bar"))
+(check-true ("foobar" . ends-with? . "r"))
+(check-true ("foobar" . ends-with? . "foobar"))
+(check-false ("foobar" . ends-with? . "foo"))
+
+;  (check-equal? (trim (list "\n" " " 1 2 3 "\n") whitespace?) '(1 2 3))
+(check-equal? (trim (list 1 3 2 4 5 6 8 9 13) odd?) '(2 4 5 6 8))
+; (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)))
\ No newline at end of file