Add a distribution framework

[bettersearch.git] / bettersearch.rkt

diff --git a/bettersearch.rkt b/bettersearch.rkt
new file mode 100644 (file)
index 0000000..4fc695e
--- /dev/null
+++ b/bettersearch.rkt
@@ -0,0 +1,95 @@
+#lang racket
+
+(require json)
+(require web-server/servlet)
+(require web-server/servlet-env)
+(require web-server/templates)
+
+(require "blacklist.rkt")
+
+(define (member-match? itm lst)
+  (ormap (lambda (i) (regexp-match? (regexp i) itm)) lst))
+
+(define-values (dispatch generate-url)
+  (dispatch-rules
+    [("") do-index]
+    [("search") do-search]
+    ))
+
+(define (do-head title)
+  (include-template "templates/head.html"))
+
+(define (do-footer)
+  (include-template "templates/footer.html"))
+
+(define (do-index req)
+  (http-response (string-append
+                  (do-head "Web Search")
+                  (include-template "templates/index.html")
+                  (do-footer))))
+
+(define (search query pageno)
+  (define engine (string->url
+                  (string-append
+                    (getenv "SEARX_INSTANCE")
+                    "/search?format=json&q="
+                    query
+                    "&pageno="
+                    pageno
+                    )))
+  (define response (get-pure-port engine))
+  (define json-raw (port->string response))
+  (close-input-port response)
+  (with-input-from-string json-raw (lambda () (read-json))))
+
+(define (http-response content)
+  (response/full
+    200
+    #"OK"
+    (current-seconds)
+    TEXT/HTML-MIME-TYPE
+    '()
+    (list
+      (string->bytes/utf-8 content))))
+
+(define (do-search req)
+  (define binds (request-bindings req))
+  (define query (if (exists-binding? 'q binds)
+                 (extract-binding/single 'q binds)
+                 ""))
+
+  (if (non-empty-string? query)
+    (let ()
+      (define pageno (if (exists-binding? 'pageno binds)
+                      (extract-binding/single 'pageno binds)
+                      "1"))
+      (define results
+       (foldr cons '()
+              (filter hash?
+                      (map (lambda (i)
+                             (define result-host
+                               (url-host (string->url
+                                           (hash-ref i 'url ""))))
+                             (define result-url (hash-ref i 'url ""))
+                             (define result-title (hash-ref i 'title ""))
+                             (define result-content (hash-ref i 'content ""))
+                             (define ht (make-hash))
+                             (unless (member-match? result-host blacklist)
+                               (let ()
+                                 (hash-set! ht "title" result-title)
+                                 (hash-set! ht "url" result-url)
+                                 (hash-set! ht "content" result-content)
+                                 )
+                               ht
+                               ))
+                           (hash-ref (search query pageno) 'results)))))
+      (http-response (string-append
+                      (do-head (string-append query " | Web Search"))
+                      (include-template "templates/search.html")
+                      (do-footer))))
+    (redirect-to "/")))
+
+(serve/servlet dispatch
+              #:command-line? #t
+              #:servlet-regexp #rx""
+              #:extra-files-paths (list (build-path "./static")))