diff --git a/srv/content/comments.hy b/srv/content/comments.hy
new file mode 100644
index 0000000..8cb9de1
--- /dev/null
+++ b/srv/content/comments.hy
@@ -0,0 +1,43 @@
+(import urllib.parse [quote-plus urlparse])
+(import os [mkdir])
+(import os.path [isdir :as dir? isfile :as file? abspath])
+(import datetime [datetime])
+(import bleach [clean])
+(import validators [domain :as domain?])
+(require hyrule.destructure [setv+])
+
+(defn create-comment [request]
+ (setv now (datetime.now))
+
+ (setv url-comment-dir (quote-plus (. request (get "route") (get "parameters") (get "route")) :safe ""))
+
+ (when (not (dir? "./www/data"))
+ (mkdir "./www/data"))
+
+ (when (not (dir? f"./www/data/comments"))
+ (mkdir "./www/data/comments"))
+
+ (when (not (dir? f"./www/data/comments/{url-comment-dir}"))
+ (mkdir f"./www/data/comments/{url-comment-dir}"))
+
+ (setv+ {{comment "comment" name "name" site "site"} "body"} request)
+
+ (when (.startswith site "//")
+ (setv site (.replace site "//" "")))
+
+ (setv [protocol domain path #* _] (urlparse
+ (if (in "://" site)
+ site
+ (+ "http://" site))))
+
+ (setv site-valid? (= (domain? domain) True))
+
+ (when (not protocol)
+ (setv protocol "//"))
+
+ (with [f (open f"./www/data/comments/{url-comment-dir}/{(.strftime now "%Y-%m-%d_%H:%M:%S_%f")}" "w")]
+ (.write f f"
"))
+
+ (return (dict
+ :code 303
+ :headers {"Location" (. request (get "headers") (get "Referer"))})))
diff --git a/srv/content/router.hy b/srv/content/router.hy
index 359b525..32c198b 100644
--- a/srv/content/router.hy
+++ b/srv/content/router.hy
@@ -1,12 +1,12 @@
-(require hyrule.destructure [defn+ setv+])
+(require hyrule.destructure [defn+])
(require hyrule.argmove [doto])
+(require hyrule.oop [meth])
+(import hyrule.collections [assoc])
(import content.file-io [parse-html-file send-raw-file])
-(import urllib.parse [quote-plus urlparse])
-(import os [mkdir])
+(import content.comments [create-comment])
+(import re)
+(import functools [lru-cache])
(import os.path [isdir :as dir? isfile :as file? abspath])
-(import datetime [datetime])
-(import bleach [clean])
-(import validators [domain :as domain?])
(defmacro unless [test #* body]
`(when (not ~test) (do ~@body)))
@@ -14,119 +14,87 @@
(defn error [code message]
(return (dict
:code code
- :body (parse-html-file "./www/site/html/error.html"))))
+ :body (parse-html-file "./www/site/html/error.html" :code code :message message))))
-(defn+ match-request [{method "method" {path "path"} "route" :as request}]
- (when (.startswith path "/assets/")
- (when (!= method "GET")
- (return (error 405 "method not allowed")))
+(defclass always []
+ (meth __init__ [@value])
+ (meth __getitem__ [_] @value))
- (setv [headers data] (send-raw-file (+ "./www/site" path)))
-
- (return (dict
- :code 200
- :headers headers
- :body data)))
-
- (when (.startswith path "/html/")
- (when (!= method "GET")
- (return (error 405 "method not allowed")))
-
- (when (file? (+ "./www/site/html" path))
- (unless (= path "/html/view-thought.html")
- (return (dict
- :code 200
- :body (parse-html-file f"./www/site/html{path}"))))
-
- (return (dict
- :code 200
- :body (parse-html-file "./www/site/html/html/view-thought.html" #** (dfor [k v] (.items (. request (get "route") (get "parameters"))) k (quote-plus v)))))))
-
- (when (= path "/style.css")
- (when (!= method "GET")
- (return (error 405 "method not allowed")))
-
- (setv [headers data] (send-raw-file "./www/site/assets/style.css"))
- (return (dict
- :code 200
- :headers headers
- :body data)))
+(defclass method-map []
+ (meth __init__ [] (setv @methods {}))
+ (meth __getattr__ [attr]
+ (if (in attr @methods)
+ (get @methods attr)
+ (fn [value] (setv (get @methods attr) value))))
- (when (= path "/robots.txt")
- (when (!= method "GET")
- (return (error 405 "method not allowed")))
+ (meth __getitem__ [item]
+ (setv item (.get @methods item None))
+ (if item
+ item
+ (fn [#* _] (error 405 "method not allowed")))))
- (return (dict
- :code 200
- :headers {"Content-Type" "text/plain"}
- :body "user-agent: *\ndisallow: /\n")))
-
- (when (= path "/")
- (when (!= method "GET")
- (return (error 405 "method not allowed")))
-
- (return (dict
- :code 200
- :body (parse-html-file "./www/site/html/home.html" :route "/"))))
-
- (when (= path "/test.html")
- (when (!= method "GET")
- (return (error 405 "method not allowed")))
-
- (return (dict
- :code 200
- :body (parse-html-file "./www/site/html/test.html" :route "/test.html"))))
-
- (when (= path "/files/natalieee.net.png")
- (return (dict
- :code 308
- :headers {"Location" "/assets/88x31/natalieee.net.png"}
- :body "")))
-
- (when (= path "/comment")
+(defclass router []
+ (meth __init__ []
+ (setv @route-map {})
+ (setv @route-cache {}))
+
+ (meth add-route [route]
+ (when (not-in route @route-map)
+ (setv (get @route-map route) (method-map)))
+
+ (return (get @route-map route)))
+
+ (meth [lru-cache] get-route-by-path [path]
(cond
- (= method "POST") (do
- (setv now (datetime.now))
-
- (setv url-comment-dir (quote-plus (. request (get "route") (get "parameters") (get "route")) :safe ""))
-
- (when (not (dir? "./www/data"))
- (mkdir "./www/data"))
-
- (when (not (dir? f"./www/data/comments"))
- (mkdir "./www/data/comments"))
-
- (when (not (dir? f"./www/data/comments/{url-comment-dir}"))
- (mkdir f"./www/data/comments/{url-comment-dir}"))
-
- (setv+ {{comment "comment" name "name" site "site"} "body"} request)
-
- (when (.startswith site "//")
- (setv site (.replace site "//" "")))
-
- (setv [protocol domain path #* _] (urlparse
- (if (in "://" site)
- site
- (+ "http://" site))))
-
- (setv site-valid? (= (domain? domain) True))
-
- (when (not protocol)
- (setv protocol "//"))
-
- (print protocol domain path site-valid?)
-
-
- (with [f (open f"./www/data/comments/{url-comment-dir}/{(.strftime now "%Y-%m-%d_%H:%M:%S_%f")}" "w")]
- (.write f f""))
+ (in path @route-map) (do (get @route-map path))
+ True (do
+ (while (> (.count path "/") 1)
+ (setv path (.join "/" (get (.split path "/") (slice 0 -1))))
+ (when (in (+ path "/*") @route-map)
+ (setv handler (get @route-map (+ path "/*")))
+ (return handler)))
- (return (dict
- :code 303
- :headers {"Location" (. request (get "headers") (get "Referer"))})))
+ (always (fn [#* _] (error 404 "not-found)")))))))
- (= method "GET") (error 405 "method not allowed")))
+(setv routes (router))
- (return (dict
- :code 404
- :body (parse-html-file "./www/site/html/error.html" :code 404 :message f"{path} not found"))))
+(defmacro route [route method]
+ `(. (routes.add-route ~route) ~(hy.models.Symbol method)))
+
+(defreader route-args
+ (.slurp-space &reader)
+ (if (= (.peekc &reader) "[")
+ `[method path request ~@(.parse-one-form &reader)]
+ '[method path request]))
+
+(defn if-file-exists [* base-path otherwise]
+ (fn [f]
+ (fn [method path request]
+ (if (file? f"{base-path}{path}")
+ (f method path request)
+ otherwise))))
+
+(defn forward-params [#* params]
+ (fn [f]
+ (fn [method path request]
+ (f method path request #** (dict (lfor param params
+ :if (setx value (. request (get "route") (get "parameters") (get param None)))
+ #(param value)))))))
+
+(defn shtml-file-response [file [code 200] [template-params {}]]
+ (dict :code code :body (parse-html-file f"./www/site/html/{file}" #** template-params)))
+
+(defn raw-file-response [file [code 200]]
+ (dict :code code #** (dict (zip ["headers" "body"] (send-raw-file f"./www/site/{file}")))))
+
+(defn [(route "/" "GET")] /home #route-args (shtml-file-response "home.html"))
+(defn [(route "/html/*" "GET") (if-file-exists :base-path "./www/site/html" :otherwise (error 404 "not found"))] /html/* #route-args (shtml-file-response path))
+(defn [(route "/assets/*" "GET") (if-file-exists :base-path "./www/site/" :otherwise (error 404 "not found"))] /assets/* #route-args (raw-file-response path))
+(defn [(route "/html/view-thought.html" "GET") (forward-params "thought" "filter-tag")] /html/view-thought #route-args [#** template-args] (shtml-file-response "/html/view-thought.html" :template-params template-args))
+(defn [(route "/comment" "POST")] /comments #route-args (create-comment request))
+(defn [(route "/robots.txt" "GET") ] /robots #route-args (dict :code 200 :headers {"Content-Type" "text/plain"} :body "User-agent *\nDisallow: /\n"))
+
+(defn+ [lru-cache] match-request [{method "method" {path "path"} "route" :as request}]
+ ((get (routes.get-route-by-path path) method) method path request))
+
diff --git a/srv/http_utils/request.hy b/srv/http_utils/request.hy
index c74553d..8fbe7f7 100644
--- a/srv/http_utils/request.hy
+++ b/srv/http_utils/request.hy
@@ -2,17 +2,27 @@
(require hyrule.control [branch])
(require hyrule.argmove [doto])
(require hyrule.collections :readers [s])
+(require hyrule.oop [meth])
(import urllib.parse [urlsplit unquote-plus parse-qs])
+(defclass hashable-dict [dict]
+ ;; this is ok because requests are never mutated after being built.
+ (meth __key []
+ (tuple (sorted (@items))))
+
+ (meth __hash__ []
+ (hash (@__key))))
+
(defn parse-url-encoded [query]
- (dfor pair (.items (parse-qs (unquote-plus query) :keep-blank-values True))
- (get pair 0)
- (cond
- (get pair 1 0) (get pair 1 0)
- True "")))
+ (hashable-dict
+ (dfor pair (.items (parse-qs (unquote-plus query) :keep-blank-values True))
+ (get pair 0)
+ (cond
+ (get pair 1 0) (get pair 1 0)
+ True ""))))
(defn parse-data [data]
- (setv request {})
+ (setv request (hashable-dict))
(setv [head #* body] (.split data b"\r\n\r\n"))
(setv [request-line #* headers] (.split head b"\r\n"))
@@ -22,7 +32,7 @@
(assoc "method" http-method)
(assoc "route" (let
[[_ _ path query _] (urlsplit route)]
- (dict
+ (hashable-dict
:path (.join "/"
(do
(setv segments [])
@@ -36,7 +46,7 @@
:parameters (parse-url-encoded query))))
(assoc "version" http-version)
- (assoc "headers" (dict
+ (assoc "headers" (hashable-dict
(dfor header
(map (fn [x]
(.split (.decode x "utf-8") ": ")) headers)
@@ -54,4 +64,4 @@
;; (print "boundary" boundary)
;; (print (.split (.join b"\n" body) (.encode boundary "utf-8"))))))
else (raise (NotImplementedError f"{(get (.split (. request (get "headers") (get "Content-Type")) ";") 0)} parsing is TODO"))))))
-
+