<commit_before>#lang racket
(require (for-syntax racket/base)
         web-server/private/connection-manager
         web-server/http
         web-server/private/web-server-structs
         net/url
         mzlib/pretty
         mzlib/list
         xml
         tests/eli-tester
         web-server/private/timer)
(provide make-module-eval
         make-eval/mod-path
         make-mock-connection
         redact
         collect
         htxml
         call)

(define keyword->symbol (compose string->symbol keyword->string))
(define (simple-xpath/xexpr p x)
  (match p
    [(list)
     (list x)]
    [(list-rest (? symbol? s) r)
     (match x
       [(list-rest (? (curry equal? s)) rs)
        (simple-xpath/tag-body r rs)]
       [_
        empty])]
    [_
     empty]))
(define (simple-xpath/tag-body p x)
  (match p
    [(list)
     (match x
       [(list) empty]
       [(list-rest (list (list (? symbol?) (? string?)) ...) rs)
        (simple-xpath/tag-body p rs)]
       [(? list?)
        x]
       [_ 
        empty])]
    [(list-rest (? symbol?) _)
     (match x
       [(list-rest (list (list (? symbol?) (? string?)) ...) rs)
        (simple-xpath/tag-body p rs)]
       [(? list?)
        (append-map (curry simple-xpath/xexpr p) x)]
       [_
        empty])]
    [(list (? keyword? k))
     (match x
       [(list-rest (and attrs (list (list (? symbol?) (? string?)) ...)) rs)
        (simple-xpath/attr (keyword->symbol k) attrs)]
       [_
        empty])]
    [_
     empty]))
(define (simple-xpath/attr k attrs)
  (dict-ref attrs k empty))
(define (simple-xpath*/list p x)
  (append (simple-xpath/xexpr p x)
          (match x
            [(list-rest (list (cons (? symbol?) (? string?)) ...) rs)
             (simple-xpath*/list p rs)]
            [(? list?)
             (append-map (curry simple-xpath*/list p) x)]
            [_
             empty])))
(define (simple-xpath* p x)
  (match (simple-xpath*/list p x)
    [(list) #f]
    [(list-rest f rs) f]))

(test
 (simple-xpath*/list '(p) '(html (body (p "Hey") (p "Bar")))) => (list "Hey" "Bar")
 (simple-xpath* '(p) '(html (body (p "Hey")))) => "Hey"
 (simple-xpath* '(p #:bar) '(html (body (p ([bar "Zog"]) "Hey")))) => "Zog")    

(provide simple-xpath*
         simple-xpath*/list)

(define (call d u bs)
  (htxml (collect d (make-request #"GET" (string->url u) empty (delay bs) #"" "127.0.0.1" 80 "127.0.0.1"))))
(define (htxml bs)
  (match (regexp-match #"^.+\r\n\r\n(.+)$" bs)
    [(list _ s)
     (string->xexpr (bytes->string/utf-8 s))]
    [_
     (error 'html "Given ~S\n" bs)]))

; This causes infinite loop. I will try putting it in a thread like on the real server
#;(define (collect d req)
    (define-values (c i o) (make-mock-connection #""))
    (parameterize ([current-server-custodian (current-custodian)])
      (d c req))
    (redact (get-output-bytes o)))

; This causes errors because s/s/d tries to jump the barrier, but I have no idea why
(define (collect d req)<commit_msg>Fixing redirectget test<commit_after>#lang racket
(require (for-syntax racket/base)
         web-server/private/connection-manager
         web-server/http
         web-server/private/web-server-structs
         net/url
         mzlib/pretty
         mzlib/list
         xml
         tests/eli-tester
         web-server/private/timer)
(provide make-module-eval
         make-eval/mod-path
         make-mock-connection
         redact
         collect
         htxml
         call)

(define keyword->symbol (compose string->symbol keyword->string))
(define (simple-xpath/xexpr p x)
  (match p
    [(list)
     (list x)]
    [(list-rest (? symbol? s) r)
     (match x
       [(list-rest (? (curry equal? s)) rs)
        (simple-xpath/tag-body r rs)]
       [_
        empty])]
    [_
     empty]))
(define (simple-xpath/tag-body p x)
  (match p
    [(list)
     (match x
       [(list) empty]
       [(list-rest (list (list (? symbol?) (? string?)) ...) rs)
        (simple-xpath/tag-body p rs)]
       [(? list?)
        x]
       [_ 
        empty])]
    [(list-rest (? symbol?) _)
     (match x
       [(list-rest (list (list (? symbol?) (? string?)) ...) rs)
        (simple-xpath/tag-body p rs)]
       [(? list?)
        (append-map (curry simple-xpath/xexpr p) x)]
       [_
        empty])]
    [(list (? keyword? k))
     (match x
       [(list-rest (and attrs (list (list (? symbol?) (? string?)) ...)) rs)
        (simple-xpath/attr (keyword->symbol k) attrs)]
       [_
        empty])]
    [_
     empty]))
(define (simple-xpath/attr k attrs)
  (dict-ref attrs k empty))
(define (simple-xpath*/list p x)
  (append (simple-xpath/xexpr p x)
          (match x
            [(list-rest (list (cons (? symbol?) (? string?)) ...) rs)
             (simple-xpath*/list p rs)]
            [(? list?)
             (append-map (curry simple-xpath*/list p) x)]
            [_
             empty])))
(define (simple-xpath* p x)
  (match (simple-xpath*/list p x)
    [(list) #f]
    [(list-rest f rs) f]))

(test
 (simple-xpath*/list '(p) '(html (body (p "Hey") (p "Bar")))) => (list "Hey" "Bar")
 (simple-xpath* '(p) '(html (body (p "Hey")))) => "Hey"
 (simple-xpath* '(p #:bar) '(html (body (p ([bar "Zog"]) "Hey")))) => "Zog")    

(provide simple-xpath*
         simple-xpath*/list)

(define (call d u bs)
  (htxml (collect d (make-request #"GET" (string->url u) empty (delay bs) #"" "127.0.0.1" 80 "127.0.0.1"))))
(define (htxml bs)
  (match (regexp-match #"^.+\r\n\r\n(.*)$" bs)
    [(list _ #"")
     ""]
    [(list _ s)
     (string->xexpr (bytes->string/utf-8 s))]
    [_
     (error 'html "Given ~S\n" bs)]))

; This causes infinite loop. I will try putting it in a thread like on the real server
#;(define (collect d req)
    (define-values (c i o) (make-mock-connection #""))
    (parameterize ([current-server-custodian (current-custodian)])
      (d c req))
    (redact (get-output-bytes o)))

; This causes errors because s/s/d tries to jump the barrier, but I have no idea why
(define (collect d req)
{'fraction_non_alphanumeric': 0.1817119973302186, 'fraction_numerical': 0.005005840146837978, 'mean_word_length': 2.0833333333333335, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 23, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 8}, 'pii_count': 4, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5544369', 'n_tokens_mistral': 2219, 'n_tokens_neox': 2116, 'n_words': 570}