~jzp/casemate

4f0d9475c3901f20c11eeb0b05d6b93f403bee61 — Johan Persson 6 months ago 5caba46
Added support for HTTP-casing
3 files changed, 103 insertions(+), 34 deletions(-)

M README.md
M casemate.scrbl
M main.rkt
M README.md => README.md +18 -9
@@ 20,41 20,50 @@ converts it to the corresponding style.

```racket
(->PascalCase string-like) -> (or/c symbol? string? bytes)
  string-like : (or/c symbol? string? bytes?)             
  string-like : (or/c symbol? string? bytes?)
```

```racket
(->Camel_Snake_Case string-like) -> (or/c symbol? string? bytes)
  string-like : (or/c symbol? string? bytes?)                   
  string-like : (or/c symbol? string? bytes?)
```

```racket
(->camelCase string-like) -> (or/c symbol? string? bytes)
  string-like : (or/c symbol? string? bytes?)            
  string-like : (or/c symbol? string? bytes?)
```

```racket
(->SCREAMING_SNAKE_CASE string-like)         
 -> (or/c symbol? string? bytes)             
(->SCREAMING_SNAKE_CASE string-like)
 -> (or/c symbol? string? bytes)
  string-like : (or/c symbol? string? bytes?)
```

```racket
(->snake_case string-like) -> (or/c symbol? string? bytes)
  string-like : (or/c symbol? string? bytes?)             
  string-like : (or/c symbol? string? bytes?)
```

```racket
(->kebab-case string-like) -> (or/c symbol? string? bytes)
  string-like : (or/c symbol? string? bytes?)             
  string-like : (or/c symbol? string? bytes?)
```

```racket
(->SCREAMING-KEBAB-CASE string-like)         
 -> (or/c symbol? string? bytes)             
(->SCREAMING-KEBAB-CASE string-like)
 -> (or/c symbol? string? bytes)
  string-like : (or/c symbol? string? bytes?)
```

```racket
(->HTTP-Case string-like) -> (or/c symbol? string? bytes)
  string-like : (or/c symbol? string? bytes?)
```

This is an odd one: it performs a lookup on special words that require a
canonical casing, use them if they match, otherwise will fall back on
`string-titlecase`.

## 3. Copyright & License

Copyright © 2019 Johan Persson.

M casemate.scrbl => casemate.scrbl +7 -0
@@ 38,6 38,13 @@ and converts it to the corresponding style.
@defproc[(->SCREAMING-KEBAB-CASE [string-like (or/c symbol? string? bytes?)])
         (or/c symbol? string? bytes)]

@defproc[(->HTTP-Case [string-like (or/c symbol? string? bytes?)])
         (or/c symbol? string? bytes)]

This is an odd one: it performs a lookup on special words that require a
canonical casing, use them if they match, otherwise will fall back on
@code["string-titlecase"].

@section{Copyright & License}

Copyright © 2019 Johan Persson.

M main.rkt => main.rkt +78 -25
@@ 34,6 34,35 @@
(require srfi/26) ;; For the handy cut-function


;;;; Constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; List of special words in HTTP headers.
;;; Made into an association list for quick lookup.
(define http-header-special-words
  (map (lambda (component)
         (cons (string-downcase component) component))
       '("MD5"
         "HTTP2"
         "TE"
         "DNT"
         "ATT"
         "UIDH"
         "XSRF"
         "CSRFToken"
         "ETag"
         "P3P"
         "WWW"
         "CSP"
         "ID"
         "UA"
         "XSS"
         "SSL"
         "HTTP"
         "HTTPS"
         "IM"
         "WAP")))


;;;; Utility functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Splits a string on lower-case/upper-case character-pairs without


@@ 76,6 105,13 @@
                     (map cdr-case (cdr components)))
               separator))

;;; HTTP header case converter.
(define (http-case str)
  (let ([special (assoc (string-downcase str) http-header-special-words)])
    (if (eq? special #f)
      (string-titlecase str)
      (cdr special))))

;;; Converts symbols and byte-strings to strings and back.
;;; Throws an exception if the given data is nonsense.
(define (->string-> thing-applier thing)


@@ 99,6 135,7 @@
(define ->snake_case           (make-converter string-downcase  string-downcase  "_"))
(define ->kebab-case           (make-converter string-downcase  string-downcase  "-"))
(define ->SCREAMING-KEBAB-CASE (make-converter string-upcase    string-upcase    "-"))
(define ->HTTP-Case            (make-converter http-case        http-case        "-"))


;;;; Exports ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


@@ 112,7 149,8 @@
           [->SCREAMING_SNAKE_CASE converter/c]
           [->snake_case           converter/c]
           [->kebab-case           converter/c]
           [->SCREAMING-KEBAB-CASE converter/c]))
           [->SCREAMING-KEBAB-CASE converter/c]
           [->HTTP-Case            converter/c]))


;;;; Tests ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


@@ 172,58 210,73 @@
               "should fail when given nonsense data"))

  (test-case
    "Procedure: http-case"
    (check-equal? (http-case "Http")
                  "HTTP"
                  "should return upper-cased string for a special word")
    (check-equal? (http-case "foo")
                  "Foo"
                  "should return title-cased string for an ordinary word"))

  (test-case
    "Check that each converter returns the expected result for a given string"
    (define test-string "fooBar-thud_grunt beep")
    (define test-string "fooBar-thud_grunt beepHTTP")
    (check-equal? (->PascalCase test-string)
                  "FooBarThudGruntBeep")
                  "FooBarThudGruntBeepHttp")
    (check-equal? (->Camel_Snake_Case test-string)
                  "Foo_Bar_Thud_Grunt_Beep")
                  "Foo_Bar_Thud_Grunt_Beep_Http")
    (check-equal? (->camelCase test-string)
                  "fooBarThudGruntBeep")
                  "fooBarThudGruntBeepHttp")
    (check-equal? (->SCREAMING_SNAKE_CASE test-string)
                  "FOO_BAR_THUD_GRUNT_BEEP")
                  "FOO_BAR_THUD_GRUNT_BEEP_HTTP")
    (check-equal? (->snake_case test-string)
                  "foo_bar_thud_grunt_beep")
                  "foo_bar_thud_grunt_beep_http")
    (check-equal? (->kebab-case test-string)
                  "foo-bar-thud-grunt-beep")
                  "foo-bar-thud-grunt-beep-http")
    (check-equal? (->SCREAMING-KEBAB-CASE test-string)
                  "FOO-BAR-THUD-GRUNT-BEEP"))
                  "FOO-BAR-THUD-GRUNT-BEEP-HTTP")
    (check-equal? (->HTTP-Case test-string)
                  "Foo-Bar-Thud-Grunt-Beep-HTTP"))

  (test-case
    "Check that each converter returns the expected result for a given symbol"
    (define test-symbol '|fooBar-thud_grunt beep|)
    (define test-symbol '|fooBar-thud_grunt beepHTTP|)
    (check-equal? (->PascalCase test-symbol)
                  'FooBarThudGruntBeep)
                  'FooBarThudGruntBeepHttp)
    (check-equal? (->Camel_Snake_Case test-symbol)
                  'Foo_Bar_Thud_Grunt_Beep)
                  'Foo_Bar_Thud_Grunt_Beep_Http)
    (check-equal? (->camelCase test-symbol)
                  'fooBarThudGruntBeep)
                  'fooBarThudGruntBeepHttp)
    (check-equal? (->SCREAMING_SNAKE_CASE test-symbol)
                  'FOO_BAR_THUD_GRUNT_BEEP)
                  'FOO_BAR_THUD_GRUNT_BEEP_HTTP)
    (check-equal? (->snake_case test-symbol)
                  'foo_bar_thud_grunt_beep)
                  'foo_bar_thud_grunt_beep_http)
    (check-equal? (->kebab-case test-symbol)
                  'foo-bar-thud-grunt-beep)
                  'foo-bar-thud-grunt-beep-http)
    (check-equal? (->SCREAMING-KEBAB-CASE test-symbol)
                  'FOO-BAR-THUD-GRUNT-BEEP))
                  'FOO-BAR-THUD-GRUNT-BEEP-HTTP)
    (check-equal? (->HTTP-Case test-symbol)
                  'Foo-Bar-Thud-Grunt-Beep-HTTP))

  (test-case
    "Check that each converter returns the expected result for a given byte string"
    (define test-byte-string #"fooBar-thud_grunt beep")
    (define test-byte-string #"fooBar-thud_grunt beepHTTP")
    (check-equal? (->PascalCase test-byte-string)
                  #"FooBarThudGruntBeep")
                  #"FooBarThudGruntBeepHttp")
    (check-equal? (->Camel_Snake_Case test-byte-string)
                  #"Foo_Bar_Thud_Grunt_Beep")
                  #"Foo_Bar_Thud_Grunt_Beep_Http")
    (check-equal? (->camelCase test-byte-string)
                  #"fooBarThudGruntBeep")
                  #"fooBarThudGruntBeepHttp")
    (check-equal? (->SCREAMING_SNAKE_CASE test-byte-string)
                  #"FOO_BAR_THUD_GRUNT_BEEP")
                  #"FOO_BAR_THUD_GRUNT_BEEP_HTTP")
    (check-equal? (->snake_case test-byte-string)
                  #"foo_bar_thud_grunt_beep")
                  #"foo_bar_thud_grunt_beep_http")
    (check-equal? (->kebab-case test-byte-string)
                  #"foo-bar-thud-grunt-beep")
                  #"foo-bar-thud-grunt-beep-http")
    (check-equal? (->SCREAMING-KEBAB-CASE test-byte-string)
                  #"FOO-BAR-THUD-GRUNT-BEEP")))
                  #"FOO-BAR-THUD-GRUNT-BEEP-HTTP")
    (check-equal? (->HTTP-Case test-byte-string)
                  #"Foo-Bar-Thud-Grunt-Beep-HTTP")))

;;                                  ❦ ❦ ❦                                   ;;
;;                                   ❦ ❦                                    ;;