<commit_before>#lang racket

(require json
         net/url
         net/uri-codec
         "main.rkt"
         "patch-port.rkt"
         "dict-merge.rkt"
         )

(provide service?
         discovery-document->service
         local-discovery-document->service
         online-discovery-document->service
         (all-from-out "main.rkt")
         )

(define/contract (create-new-method dd method)
  (jsexpr? jsexpr? . -> . procedure?)
  (define base-uri (string-append (hash-ref dd 'rootUrl)
                                  (hash-ref dd 'servicePath)))
  ;; Parameters are the union of those for entire API and those for
  ;; this method:
  (define params (dict-merge (hash-ref dd 'parameters (hash))
                             (hash-ref method 'parameters (hash))))
  (define api-params (hash-ref dd 'parameters))
  (define api-param-names (hash-keys api-params))
  (define method-params (hash-ref method 'parameters (hasheq)))
  (define (required? x)
    (and (hash-has-key? x 'required)
         (hash-ref x 'required)))
  (define req-params (for/hasheq ([(k v) method-params]
                                  #:when (required? v))
                       (values k v)))
  (define opt-params (for/hasheq ([(k v) method-params]
                                  #:when (not (required? v)))
                       (values k v)))
  (define _body-params
    (hash-ref (hash-ref (hash-ref dd 'schemas)
                        (string->symbol
                         (hash-ref (hash-ref method 'request (hash)) '$ref ""))
                        (hash))
              'properties
              (hash)))
  ;; The "licensing" API has a problem where it duplicates a
  ;; required parameter (such as "userID" or "productID") in the
  ;; body parameters. Filter such problems here.
  (define body-params
    (for/hasheq ([(k v) _body-params]
                 #:when (not (or (hash-has-key? req-params k)
                                 (hash-has-key? opt-params k)
                                 (hash-has-key? api-params k))))
      (values k v)))
  (define request
    (match (hash-ref method 'httpMethod)
      ["GET" (lambda (url body h) (get-pure-port url h))]
      ["POST" post-pure-port]
      ["PUT" put-pure-port]
      ["DELETE" delete-pure-port]
      ["PATCH" patch-pure-port]
      [(var m) (error 'create-new-method "HTTP method ~a not supported" m)]))
  ;; A procedure that takes a dict, and does the actual work of making
  ;; a request to the server.
  (define/contract (f/dict d)
    (dict? . -> . jsexpr?)
    (define u (string-append base-uri
                             (template-path (hash-ref method 'path) d)))
    (define qps (filter values
                        (for/list ([(k v) (in-dict d)])
                          (define p (hash-ref params k #f))
                          (cond
                           [(not p) #f]
                           [else (match (hash-ref p 'location)
                                   ["path" #f]
                                   [else (cons k v)])]))))
    (define url
      (string->url
       (cond [(empty? qps) u]
             [else (string-append u
                                  "?"
                                  (alist->form-urlencoded qps))])))
    (define body
      (jsexpr->bytes
       (for/hasheq ([k (hash-keys body-params)])
         (values k (dict-ref d k "")))))
    (define h (list "Content-Type: application/json"))
    (define in (request url body h))
    (define js (bytes->jsexpr (port->bytes in)))
    (close-input-port in)
    js)
  ;; Wrap f/dict in a procedure that takes keyword arguments instead
  ;; of a dict.
  (define symbol->keyword (compose1 string->keyword symbol->string))
  (define keyword->symbol (compose1 string->symbol keyword->string))
  (define (keyword<=? a b) (string<=? (keyword->string a) (keyword->string b)))
  (define (maybe-add-api-key d)
    (cond [(dict-has-key? d 'key) d]
          [else (dict-set* d 'key (api-key))]))
  (define f/kw (make-keyword-procedure
                (lambda (kws vs . rest)
                  (f/dict (maybe-add-api-key (map cons
                                                  (map keyword->symbol kws)
                                                  vs))))))
  ;; Tweak that procedure to accept only specific required and
  ;; optional keyword arguments.
  (define req-kws (sort (map symbol->keyword (hash-keys req-params)) keyword<=?))
  (define opt-kws (map symbol->keyword (hash-keys opt-params)))
  (define body-kws (map symbol->keyword (hash-keys body-params)))
  (define api-kws (map symbol->keyword (hash-keys api-params)))
  (define all-kws (sort (append req-kws opt-kws body-kws api-kws) keyword<=?))
  (procedure-reduce-keyword-arity f/kw 0 req-kws all-kws))

(define (template-path str d)
  (string-join (for/list ([x (regexp-split #rx"/" str)])
                 (match x
                   [(pregexp "^\\{(.+)\\}$" (list _ k))
                    (dict-ref d (string->symbol k))]
                   [else x]))
               "/"))

;; Exactly like jsexpr? except allows procedure? as a value.
(define (service? x #:null [jsnull (json-null)])
  (let loop ([x x])
    (or (procedure? x) ; <=== ONLY difference from `jsexpr?'
        (exact-integer? x)
        (inexact-real? x)
        (boolean? x)
        (string? x)
        (eq? x jsnull)
        (and (list? x) (andmap loop x))
        (and (hash? x) (for/and ([(k v) (in-hash x)])
                         (and (symbol? k) (loop v)))))))
<commit_msg>Just change some line breaks.<commit_after>#lang racket

(require json
         net/url
         net/uri-codec
         "main.rkt"
         "patch-port.rkt"
         "dict-merge.rkt"
         )

(provide service?
         discovery-document->service
         local-discovery-document->service
         online-discovery-document->service
         (all-from-out "main.rkt")
         )

(define/contract (create-new-method dd method)
  (jsexpr? jsexpr? . -> . procedure?)
  (define base-uri (string-append (hash-ref dd 'rootUrl)
                                  (hash-ref dd 'servicePath)))
  ;; Parameters are the union of those for entire API and those for
  ;; this method:
  (define params (dict-merge (hash-ref dd 'parameters (hash))
                             (hash-ref method 'parameters (hash))))
  (define api-params (hash-ref dd 'parameters))
  (define api-param-names (hash-keys api-params))
  (define method-params (hash-ref method 'parameters (hasheq)))
  (define (required? x)
    (and (hash-has-key? x 'required)
         (hash-ref x 'required)))
  (define req-params (for/hasheq ([(k v) method-params]
                                  #:when (required? v))
                       (values k v)))
  (define opt-params (for/hasheq ([(k v) method-params]
                                  #:when (not (required? v)))
                       (values k v)))
  (define _body-params
    (hash-ref (hash-ref (hash-ref dd 'schemas)
                        (string->symbol
                         (hash-ref (hash-ref method 'request (hash)) '$ref ""))
                        (hash))
              'properties
              (hash)))
  ;; The "licensing" API has a problem where it duplicates a
  ;; required parameter (such as "userID" or "productID") in the
  ;; body parameters. Filter such problems here.
  (define body-params
    (for/hasheq ([(k v) _body-params]
                 #:when (not (or (hash-has-key? req-params k)
                                 (hash-has-key? opt-params k)
                                 (hash-has-key? api-params k))))
      (values k v)))
  (define request
    (match (hash-ref method 'httpMethod)
      ["GET" (lambda (url body h) (get-pure-port url h))]
      ["POST" post-pure-port]
      ["PUT" put-pure-port]
      ["DELETE" delete-pure-port]
      ["PATCH" patch-pure-port]
      [(var m) (error 'create-new-method "HTTP method ~a not supported" m)]))
  ;; A procedure that takes a dict, and does the actual work of making
  ;; a request to the server.
  (define/contract (f/dict d)
    (dict? . -> . jsexpr?)
    (define u (string-append base-uri
                             (template-path (hash-ref method 'path) d)))
    (define qps (filter values
                        (for/list ([(k v) (in-dict d)])
                          (define p (hash-ref params k #f))
                          (cond
                           [(not p) #f]
                           [else (match (hash-ref p 'location)
                                   ["path" #f]
                                   [else (cons k v)])]))))
    (define url
      (string->url
       (cond [(empty? qps) u]
             [else (string-append u
                                  "?"
                                  (alist->form-urlencoded qps))])))
    (define body
      (jsexpr->bytes
       (for/hasheq ([k (hash-keys body-params)])
         (values k (dict-ref d k "")))))
    (define h (list "Content-Type: application/json"))
    (define in (request url body h))
    (define js (bytes->jsexpr (port->bytes in)))
    (close-input-port in)
    js)
  ;; Wrap f/dict in a procedure that takes keyword arguments instead
  ;; of a dict.
  (define symbol->keyword (compose1 string->keyword symbol->string))
  (define keyword->symbol (compose1 string->symbol keyword->string))
  (define (keyword<=? a b) (string<=? (keyword->string a) (keyword->string b)))
  (define (maybe-add-api-key d)
    (cond [(dict-has-key? d 'key) d]
          [else (dict-set* d 'key (api-key))]))
  (define f/kw (make-keyword-procedure
                (lambda (kws vs . rest)
                  (f/dict (maybe-add-api-key (map cons
                                                  (map keyword->symbol kws)
                                                  vs))))))
  ;; Tweak that procedure to accept only specific required and
  ;; optional keyword arguments.
  (define req-kws (sort (map symbol->keyword (hash-keys req-params))
                        keyword<=?))
  (define opt-kws (map symbol->keyword (hash-keys opt-params)))
  (define body-kws (map symbol->keyword (hash-keys body-params)))
  (define api-kws (map symbol->keyword (hash-keys api-params)))
  (define all-kws (sort (append req-kws opt-kws body-kws api-kws)
                        keyword<=?))
  (procedure-reduce-keyword-arity f/kw 0 req-kws all-kws))

(define (template-path str d)
  (string-join
   (for/list ([x (regexp-split #rx"/" str)])
     (match x
       [(pregexp "^\\{(.+)\\}$" (list _ k)) (dict-ref d (string->symbol k))]
       [else x]))
   "/"))

;; Exactly like jsexpr? except allows procedure? as a value.
(define (service? x #:null [jsnull (json-null)])
  (let loop ([x x])
    (or (procedure? x) ; <=== ONLY difference from `jsexpr?'
        (exact-integer? x)
        (inexact-real? x)
        (boolean? x)
        (string? x)
        (eq? x jsnull)
        (and (list? x) (andmap loop x))
        (and (hash? x) (for/and ([(k v) (in-hash x)])
                         (and (symbol? k) (loop v)))))))

{'fraction_non_alphanumeric': 0.14462772259181628, 'fraction_numerical': 0.0005467966827667912, 'mean_word_length': 1.7183552142680207, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 53, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 26, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3159125', 'n_tokens_mistral': 3388, 'n_tokens_neox': 3254, 'n_words': 996}