Implement a working prototype

[bettersearch.git] / server.rkt

diff --git a/server.rkt b/server.rkt
index 7f7562f5ed619712b651a06ca7953a282d366c97..81abf7cb1b0cbdd5fe3edf0bcf9260dea6f7b530 100644 (file)
--- a/server.rkt
+++ b/server.rkt
@@ -1,35 +1,77 @@
 #lang racket
 
-(require web-server/servlet)
+(require json)
+(require net/url)
 (require web-server/formlets)
+(require web-server/servlet)
 (require web-server/servlet-env)
+(require web-server/templates)
+
+(require "blacklist.rkt")
 
-(require "bettersearch.rkt")
+(define (member-match? itm lst)
+  (ormap (lambda (i) (regexp-match? (regexp i) itm)) lst))
 
 (define-values (dispatch generate-url)
   (dispatch-rules
-    [("")       do-index]
+    [("index") do-index]
     [("search") do-search]
     ))
 
+(define (do-index req)
+      (http-response (include-template "index.html")))
+
+(define (search query)
+  (define engine (string->url
+                  (string-append
+                    "https://search.trom.tf/search?format=json&q=" query)))
+  (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)  ; The 'content' parameter should be a string.
+  (response/full
+    200                  ; HTTP response code.
+    #"OK"                ; HTTP response message.
+    (current-seconds)    ; Timestamp.
+    TEXT/HTML-MIME-TYPE  ; MIME type for content.
+    '()                  ; Additional HTTP headers.
+    (list                ; Content (in bytes) to send to the browser.
+      (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 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) 'results)))))
+      (http-response (include-template "search.html")))
+    (do-index req)))
 
 (serve/servlet dispatch
               #:command-line? #t
-              #:servlet-regexp #rx"")
+              #:servlet-regexp #rx""
+              #:extra-files-paths (list (build-path "./static")))