Remove unused requires

[bettersearch.git] / server.rkt

diff --git a/server.rkt b/server.rkt
index 7f7562f5ed619712b651a06ca7953a282d366c97..2b13b6c4a15e73dafe78f1ab778acfaf001b2aec 100644 (file)
--- a/server.rkt
+++ b/server.rkt
@@ -1,35 +1,94 @@
 #lang racket
 
+(require json)
 (require web-server/servlet)
-(require web-server/formlets)
 (require web-server/servlet-env)
+(require web-server/templates)
 
-(require "bettersearch.rkt")
+(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]
+    [("") 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
+                      "https://search.trom.tf/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)
+  (define query (if (exists-binding? 'q binds)
                  (extract-binding/single 'q binds)
                  ""))
 
   (if (non-empty-string? query)
-    (response/xexpr `(html
-                      (h1 "Search results")
-                      (fetch-results query)
-                      ))
-    (response/xexpr `(html
-                      (h1 "ho")
-                      ))
-    )
-  )
+    (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"")
+              #:servlet-regexp #rx""
+              #:extra-files-paths (list (build-path "./static")))