Changeset 33641 in project


Ignore:
Timestamp:
09/11/16 17:59:54 (5 years ago)
Author:
sjamaan
Message:

uri-generic: Don't use irregex in the abnf alternative example

Instead, we percent-encode/decode only using abnf, just like in the comparse example.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/uri-generic/trunk/alternatives/uri-generic.abnf.scm

    r33640 r33641  
    2323(import chicken scheme extras data-structures ports)
    2424
    25 (use extras data-structures ports irregex
    26      srfi-1 srfi-4 srfi-13 srfi-14
     25(use extras data-structures ports srfi-1 srfi-4 srfi-13 srfi-14
    2726     (prefix lexgen lg:) abnf-charlist abnf abnf-consumers)
    2827
     
    321320           ,(and-let* ((fragment (uri-fragment uri))) (list  "#" fragment))))))))
    322321
    323 
    324322(define uri-decode-string
    325   (let ((re (irregex `(seq #\% hex-digit hex-digit))))
     323  (let ((any-char (set (char-set->list char-set:full))))
    326324    (lambda (str #!optional (char-set char-set:full))
    327       (irregex-replace/all
    328        re str
    329        (lambda (match)
    330          (let* ((encoded (irregex-match-substring match))
    331                 (decoded (integer->char (string->number (string-drop encoded 1) 16))))
    332            (if (char-set-contains? char-set decoded) (string decoded) encoded)))))))
     325      (let* ((decode
     326              (lambda (contents)
     327                (let* ((encoded (car (consumed-chars->string contents)))
     328                       (decoded (integer->char (string->number (string-drop encoded 1) 16))))
     329                  (if (char-set-contains? char-set decoded)
     330                      (list (string decoded))
     331                      (list encoded)))))
     332             (escaped-char (bind* decode
     333                                  (concatenation
     334                                   (char #\%)
     335                                   (repetition-n 2 hexadecimal))))
     336             (partially-encoded
     337              (repetition
     338               (alternatives escaped-char
     339                             (bind* consumed-chars->string any-char))))
     340             (res (lg:lex partially-encoded
     341                          (constantly #f) str)))
     342        (and res (string-concatenate (car res)))))))
    333343
    334344(define (display-fragments b)
     
    414424
    415425(define normalize-pct-encoding
    416   (let ((re (irregex `(seq #\% hex-digit hex-digit)))
    417         (char-set char-set:uri-unreserved))
     426  (let* ((any-char (set (char-set->list char-set:full)))
     427         (decode
     428          (lambda (contents)
     429            (let* ((encoded (car (consumed-chars->string contents)))
     430                   (decoded (integer->char (string->number (string-drop encoded 1) 16))))
     431              (if (char-set-contains? char-set:uri-unreserved decoded)
     432                  (list (string decoded))
     433                  (list (string-upcase encoded))))))
     434         (escaped-char (bind* decode
     435                              (concatenation
     436                               (char #\%)
     437                               (repetition-n 2 hexadecimal))))
     438         (partially-encoded
     439          (repetition (alternatives escaped-char
     440                                    (bind* consumed-chars->string
     441                                           any-char)))))
    418442    (lambda (str)
    419       (irregex-replace/all
    420        re str
    421        (lambda (match)
    422          (let* ((encoded (irregex-match-substring match))
    423                 (decoded (integer->char (string->number (string-drop encoded 1) 16))))
    424            (if (char-set-contains? char-set decoded)
    425                (string decoded)
    426                (string-upcase encoded))))))))
     443      (and-let* ((res (lg:lex partially-encoded (constantly #f) str)))
     444        (string-concatenate (car res))))))
    427445
    428446(define (alist->uri contents)
Note: See TracChangeset for help on using the changeset viewer.