-
Notifications
You must be signed in to change notification settings - Fork 1
/
parser.rkt
84 lines (73 loc) · 2.6 KB
/
parser.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
#lang racket/base
(provide parse-json-pointer
json-pointer?
expression->pointer)
(require (only-in racket/contract
define/contract
->
any/c
listof)
(only-in racket/string
string-split
string-prefix?
string-replace)
(only-in racket/list
empty?
empty
first
rest)
(only-in (file "expr.rkt")
json-pointer-expression?)
(only-in (file "escape.rkt")
escape-tildes
unescape-tildes))
(module+ test
(require rackunit))
(define/contract (json-pointer? x)
(-> any/c boolean?)
(and (string? x)
(or (string=? "" x)
(string-prefix? x "/"))))
(module+ test
(check-false (json-pointer? " "))
;; examples copied from https://tools.ietf.org/html/rfc6901
(check-true (json-pointer? ""))
(check-true (json-pointer? "/foo"))
(check-true (json-pointer? "/foo/0"))
(check-true (json-pointer? "/"))
(check-true (json-pointer? "/a~1b"))
(check-true (json-pointer? "/c%d"))
(check-true (json-pointer? "/e^f"))
(check-true (json-pointer? "/g|h"))
(check-true (json-pointer? "/i\\j"))
(check-true (json-pointer? "/k\"l"))
(check-true (json-pointer? "/ "))
(check-true (json-pointer? "/m~0n")))
(define/contract (parse-json-pointer str)
(-> json-pointer? json-pointer-expression?)
(cond ((string=? "" str)
empty)
(else
(map unescape-tildes
(rest (string-split str "/" #:trim? #f))))))
(module+ test
(check-equal? empty (parse-json-pointer ""))
(check-equal? (list "") (parse-json-pointer "/"))
(check-equal? (list "frosch") (parse-json-pointer "/frosch"))
(check-equal? (list "frosch" "") (parse-json-pointer "/frosch/"))
(check-equal? (list "~") (parse-json-pointer "/~0"))
(check-equal? (list "/") (parse-json-pointer "/~1")))
(define/contract (expression->pointer steps)
(-> json-pointer-expression? json-pointer?)
(if (empty? steps)
""
(format "/~a~a" (escape-tildes (first steps)) (expression->pointer (rest steps)))))
(module+ test
(check-equal? "" (expression->pointer empty))
(check-equal? "/" (expression->pointer (list "")))
(check-equal? "/red/rum" (expression->pointer (list "red" "rum")))
(check-equal? "///" (expression->pointer (list "" "" ""))))
(module+ test
;; checking that we can deal with escaped characters
(check-equal? "/~0" (expression->pointer (list "~")))
(check-equal? "/~1" (expression->pointer (list "/"))))