1 USING: combinators.short-circuit math math.order math.parser kernel
2 sequences sequences.deep peg peg.parsers assocs arrays
3 hashtables strings unicode.case namespaces ascii ;
6 : except ( quot -- parser )
7 [ not ] compose satisfy ; inline
9 : except-these ( quots -- parser )
10 [ 1|| ] curry except ; inline
13 { [ 0 31 between? ] [ 127 = ] } 1|| ;
15 : tspecial? ( ch -- ? )
16 "()<>@,;:\\\"/[]?={} \t" member? ;
18 : 'token' ( -- parser )
19 { [ ctl? ] [ tspecial? ] } except-these repeat1 ;
21 : case-insensitive ( parser -- parser' )
22 [ flatten >string >lower ] action ;
24 : case-sensitive ( parser -- parser' )
25 [ flatten >string ] action ;
27 : 'space' ( -- parser )
28 [ " \t" member? ] satisfy repeat0 hide ;
30 : one-of ( strings -- parser )
31 [ token ] map choice ;
33 : 'http-method' ( -- parser )
34 { "OPTIONS" "GET" "HEAD" "POST" "PUT" "DELETE" "TRACE" "CONNECT" } one-of ;
37 [ " \t\r\n" member? ] except repeat1 case-sensitive ;
39 : 'http-version' ( -- parser )
48 ] seq* [ concat >string ] action ;
50 PEG: parse-request-line ( string -- triple )
51 #! Triple is { method url version }
62 : 'text' ( -- parser )
65 : 'response-code' ( -- parser )
66 [ digit? ] satisfy 3 exactly-n [ string>number ] action ;
68 : 'response-message' ( -- parser )
69 'text' repeat0 case-sensitive ;
71 PEG: parse-response-line ( string -- triple )
72 #! Triple is { version code message }
82 : 'crlf' ( -- parser )
86 [ " \t" member? ] satisfy repeat1 ;
88 : 'qdtext' ( -- parser )
89 { [ CHAR: " = ] [ ctl? ] } except-these ;
91 : 'quoted-char' ( -- parser )
92 "\\" token hide any-char 2seq ;
94 : 'quoted-string' ( -- parser )
95 'quoted-char' 'qdtext' 2choice repeat0 "\"" "\"" surrounded-by ;
97 : 'ctext' ( -- parser )
98 { [ ctl? ] [ "()" member? ] } except-these ;
100 : 'comment' ( -- parser )
101 'ctext' 'comment' 2choice repeat0 "(" ")" surrounded-by ;
103 : 'field-name' ( -- parser )
104 'token' case-insensitive ;
106 : 'field-content' ( -- parser )
107 'quoted-string' case-sensitive
108 'text' repeat0 case-sensitive
111 PEG: parse-header-line ( string -- pair )
112 #! Pair is either { name value } or { f value }. If f, its a
113 #! continuation of the previous header line.
122 'lws' [ drop f ] action ,
127 : 'word' ( -- parser )
128 'token' 'quoted-string' 2choice ;
130 : 'value' ( -- parser )
132 [ ";" member? ] except repeat0
133 2choice case-sensitive ;
135 : 'attr' ( -- parser )
136 'token' case-insensitive ;
138 : 'av-pair' ( -- parser )
143 [ "=" token , 'space' , 'value' , ] seq* [ peek ] action
144 epsilon [ drop f ] action
149 : 'av-pairs' ( -- parser )
150 'av-pair' ";" token list-of optional ;
152 PEG: (parse-set-cookie) ( string -- alist ) 'av-pairs' just ;
154 : 'cookie-value' ( -- parser )
165 PEG: (parse-cookie) ( string -- alist )
166 'cookie-value' [ ";," member? ] satisfy list-of optional just ;