bettersearch.rkt

   1 #lang racket
   2
   3 (require json)
   4 (require web-server/servlet)
   5 (require web-server/servlet-env)
   6 (require web-server/templates)
   7
   8 (require "blacklist.rkt")
   9
  10 (define (member-match? itm lst)
  11   (ormap (lambda (i) (regexp-match? (regexp i) itm)) lst))
  12
  13 (define-values (dispatch generate-url)
  14   (dispatch-rules
  15     [("") do-index]
  16     [("search") do-search]
  17     ))
  18
  19 (define (do-head title)
  20   (include-template "templates/head.html"))
  21
  22 (define (do-footer)
  23   (include-template "templates/footer.html"))
  24
  25 (define (do-index req)
  26   (http-response (string-append
  27                    (do-head "Web Search")
  28                    (include-template "templates/index.html")
  29                    (do-footer))))
  30
  31 (define (search query pageno)
  32   (define engine (string->url
  33                    (string-append
  34                      (getenv "SEARX_INSTANCE")
  35                      "/search?format=json&q="
  36                      query
  37                      "&pageno="
  38                      pageno
  39                      )))
  40   (define response (get-pure-port engine))
  41   (define json-raw (port->string response))
  42   (close-input-port response)
  43   (with-input-from-string json-raw (lambda () (read-json))))
  44
  45 (define (http-response content)
  46   (response/full
  47     200
  48     #"OK"
  49     (current-seconds)
  50     TEXT/HTML-MIME-TYPE
  51     '()
  52     (list
  53       (string->bytes/utf-8 content))))
  54
  55 (define (do-search req)
  56   (define binds (request-bindings req))
  57   (define query (if (exists-binding? 'q binds)
  58                   (extract-binding/single 'q binds)
  59                   ""))
  60
  61   (if (non-empty-string? query)
  62     (let ()
  63       (define pageno (if (exists-binding? 'pageno binds)
  64                        (extract-binding/single 'pageno binds)
  65                        "1"))
  66       (define results
  67         (foldr cons '()
  68                (filter hash?
  69                        (map (lambda (i)
  70                               (define result-host
  71                                 (url-host (string->url
  72                                             (hash-ref i 'url ""))))
  73                               (define result-url (hash-ref i 'url ""))
  74                               (define result-title (hash-ref i 'title ""))
  75                               (define result-content (hash-ref i 'content ""))
  76                               (define ht (make-hash))
  77                               (unless (member-match? result-host blacklist)
  78                                 (let ()
  79                                   (hash-set! ht "title" result-title)
  80                                   (hash-set! ht "url" result-url)
  81                                   (hash-set! ht "content" result-content)
  82                                   )
  83                                 ht
  84                                 ))
  85                             (hash-ref (search query pageno) 'results)))))
  86       (http-response (string-append
  87                        (do-head (string-append query " | Web Search"))
  88                        (include-template "templates/search.html")
  89                        (do-footer))))
  90     (redirect-to "/")))
  91
  92 (serve/servlet dispatch
  93                #:command-line? #t
  94                #:servlet-regexp #rx""
  95                #:extra-files-paths (list (build-path "./static")))