Skip to content

Commit

Permalink
more stuff.
Browse files Browse the repository at this point in the history
  • Loading branch information
@diasbruno
diasbruno committed Oct 13, 2024
1 parent 283f37c commit 144e4b3
Show file tree
Hide file tree
Showing 10 changed files with 355 additions and 266 deletions.
79 changes: 39 additions & 40 deletions routing/dsl.lisp
View file
Original file line number Diff line number Diff line change
@@ -1,18 +1,18 @@
(defpackage #:wst.routing.dsl
(:use #:cl)
(:import-from #:cl-hash-util
#:hash
#:with-keys)
#:hash
#:with-keys)
(:import-from #:wst.routing
#:any-route-handler)
#:any-route-handler)
(:import-from #:alexandria
#:ensure-list)
#:ensure-list)
(:import-from #:wst.routing
#:add-route)
#:add-route)
(:import-from #:wst.routing
#:remove-route)
#:remove-route)
(:import-from #:str
#:join)
#:join)
(:export
#:build-webserver
#:wrap
Expand All @@ -27,37 +27,37 @@
(with-keys ((bfs "befores") (paths "paths") (afs "afters"))
stack
(destructuring-bind (method &rest rest)
api
api
(let ((actions (append (reduce #'append bfs)
rest
(reduce #'append afs))))
(any-route-handler
method
(lambda (request response)
(loop :for fn :in actions
:do (funcall fn request response)
:finally (return response))))))))
rest
(reduce #'append afs))))
(any-route-handler
method
(lambda (request response)
(loop :for fn :in actions
:do (funcall fn request response)
:finally (return response))))))))

(defun %create-route (api stack)
"Execute `route` is found take the API and build with the STACK."
(with-keys ((bfs "befores") (paths "paths") (afs "afters"))
stack
(destructuring-bind (method route-name path &rest rest)
api
api
(let* ((onstack (join "" paths))
(route-path (if (stringp path) path ""))
(the-path (concatenate 'string onstack route-path))
(the-action (if (not (stringp path)) path (car rest)))
(actions (append
(reduce #'append bfs)
(ensure-list the-action)
(reduce #'append afs))))
(remove-route route-name)
(add-route route-name the-path method
(lambda (request response)
(loop :for fn :in actions
:do (funcall fn request response)
:finally (return response))))))))
(route-path (if (stringp path) path ""))
(the-path (concatenate 'string onstack route-path))
(the-action (if (not (stringp path)) path (car rest)))
(actions (append
(reduce #'append bfs)
(ensure-list the-action)
(reduce #'append afs))))
(remove-route route-name)
(add-route route-name the-path method
(lambda (request response)
(loop :for fn :in actions
:do (funcall fn request response)
:finally (return response))))))))

(defun %wrap-routes (api stack)
"Execute when `wrap is found.
Expand All @@ -70,28 +70,27 @@ api
stack
(progn
(setf bfs (append bfs (list (ensure-list (getf api :before nil))))
afs (append afs (list (ensure-list (getf api :after nil)))))
afs (append afs (list (ensure-list (getf api :after nil)))))
(%build-webserver (getf api :route) stack)
(setf bfs (butlast bfs)
afs (butlast afs)))))
afs (butlast afs)))))

(defun %build-webserver (api stack)
"Build from a API definition"
(let ((item (car api))
(routes (cdr api)))
(routes (cdr api)))
(case item
(wrap (%wrap-routes routes stack))
(any-route (%any-route routes stack))
(route (%create-route routes stack))
(group (map nil (lambda (api) (%build-webserver api stack)) routes))
(resource (destructuring-bind (path &rest rest)
(cdr api)
(setf (gethash "paths" stack)
(append (gethash "paths" stack) (list path)))
(map nil (lambda (item) (%build-webserver item stack)) rest)
(setf (gethash "paths" stack)
(butlast (gethash "paths" stack)))))
(t (error (format nil "not handled ~a" item))))))
(cdr api)
(setf (gethash "paths" stack)
(append (gethash "paths" stack) (list path)))
(map nil (lambda (item) (%build-webserver item stack)) rest)
(setf (gethash "paths" stack)
(butlast (gethash "paths" stack))))))))

(defun build-webserver (api)
"Build web server from a API definition."
Expand Down
33 changes: 33 additions & 0 deletions routing/match.lisp
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,33 @@
(in-package :wst.routing)

(declaim (ftype (function (matcher symbol list integer) list)
match))
(defun match (matcher method segments count)
"Run the MATCHER for METHOD, SEGMENTS and COUNT."
(if (or (not (= count (matcher-segments-count matcher)))
(not (equal method (matcher-method matcher))))
(list :skip nil)
(list :params (loop :for x :in (matcher-segments matcher)
:for y :in segments
:if (str:starts-with? ":" x)
:collect (cons (str:substring 1 (length x) x) y)
:else :if (not (equal x y))
:do (return-from match (list :skip nil))))))

(declaim (ftype (function (route symbol list integer) list)
do-matcher))
(defun do-matcher (route method segments count)
(destructuring-bind (action params)
(match (route-matcher route) method segments count)
(when (equal action :params)
(cons route params))))

(defun match-route (path method &optional (routes *routes*))
"Find a route by PATH and METHOD."
(let* ((segments
(remove-if (lambda (p) (or (null p) (= 0 (length p))))
(cdr (str:split "/" path))))
(count (length segments)))
(loop :for route :in routes
:do (alexandria:when-let ((match-data (do-matcher route method segments count)))
(return match-data)))))
47 changes: 17 additions & 30 deletions routing/package.lisp
View file
Original file line number Diff line number Diff line change
@@ -1,20 +1,20 @@
(defpackage #:wst.routing
(:use #:cl)
(:import-from #:cl-hash-util
#:hash-create
#:hash
#:with-keys)
#:hash-create
#:hash
#:with-keys)
(:import-from #:alexandria
#:ensure-list)
#:ensure-list)
(:import-from #:str
#:split
#:join)
#:split
#:join)
(:import-from #:flexi-streams
#:make-flexi-stream)
#:make-flexi-stream)
(:import-from #:com.inuoe.jzon
#:parse)
#:parse)
(:import-from #:uiop
#:read-file-string)
#:read-file-string)
(:export
#:request
#:response
Expand All @@ -37,6 +37,7 @@
#:make-response
#:request-data
#:request-uri
#:request-query
#:request-method
#:request-headers
#:request-content
Expand All @@ -48,26 +49,12 @@
#:request-content-length
#:write-response
#:unprocessable-entity
#:parse-uri))
#:parse-uri
#:dispatch-route-by-route
#:route-uri-of
#:route-path
#:with-request-params
#:with-response-data
#:with-request-data))

(in-package :wst.routing)

(defstruct request
"Request object."
(uri "" :type string)
(method :GET :type symbol)
(headers (hash-create nil) :type hash-table)
(content-type nil :type (or string null))
(content-length 0 :type integer)
content
(data nil :type list))

(defstruct response
"Response object."
(status 0 :type integer)
(headers nil :type list)
(content "" :type string)
(data nil :type list))

(defvar *routes* nil
"Hash to hold all routes.")
91 changes: 41 additions & 50 deletions routing/routes.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -90,40 +90,6 @@
*routes*))
t)

(declaim (ftype (function (matcher symbol list integer) list)
match))
(defun match (matcher method segments count)
"Run the MATCHER for METHOD, SEGMENTS and COUNT."
(if (or (not (= count (matcher-segments-count matcher)))
(not (equal method (matcher-method matcher))))
(list :skip nil)
(list :params (loop :for x :in (matcher-segments matcher)
:for y :in segments
:if (str:starts-with? ":" x)
:collect (cons (str:substring 1 (length x) x) y)
:else :if (not (equal x y))
:do (return-from match (list :skip nil))))))

(declaim (ftype (function (route symbol list integer) list)
do-matcher))
(defun do-matcher (route method segments count)
(destructuring-bind (action params)
(match (route-matcher route) method segments count)
(when (equal action :params)
(cons route params))))

(declaim (ftype (function (string symbol &optional list) list)
match-route))
(defun match-route (path method &optional (routes *routes*))
"Find a route by PATH and METHOD."
(let* ((segments
(remove-if (lambda (p) (or (null p) (= 0 (length p))))
(cdr (str:split "/" path))))
(count (length segments)))
(loop :for route :in routes
:do (alexandria:when-let ((match-data (do-matcher route method segments count)))
(return match-data)))))

(declaim (ftype (function (string) hash-table)
parse-cookies-string))
(defun parse-cookies-string (cookies)
Expand All @@ -148,11 +114,12 @@
(list :cookies nil)))
t))

(declaim (ftype (function (symbol) (or route null))
(declaim (ftype (function (symbol &optional list) (or route null))
find-route-by-name))
(defun find-route-by-name (name)
(defun find-route-by-name (name &optional (routes *routes*))
"Find a route by NAME."
(find name *routes* :test 'equal :key 'route-name))
(let ((sname (symbol-name name)))
(find-if (lambda (route) (string-equal sname (symbol-name (route-name route)))) routes)))

(defun %dispatcher (route request response)
"The dispatcher for any kind of dispatch. ROUTE-DATA is a pair of a route and the params and a request object."
Expand All @@ -162,7 +129,6 @@
(rs (funcall fn request response)))
rs)
(t (err)
(log:error "unhandled error ~a" err)
(or (and *condition-handler* (funcall *condition-handler* request response err))
(funcall #'default-internal-server-error-resounse response)))))

Expand All @@ -172,9 +138,9 @@
request
(let* ((response (make-response))
(found (or (match-route uri method)
(and *any-route-handler*
(equal (request-method request) (route-method *any-route-handler*))
(cons *any-route-handler* nil)))))
(and *any-route-handler*
(equal (request-method request) (route-method *any-route-handler*))
(cons *any-route-handler* nil)))))
(parse-cookies headers request response)
(if (not found)
(%dispatcher nil request response)
Expand All @@ -185,19 +151,35 @@
(append (request-data request) (list :params params)))
(%dispatcher route request response)))))))

(defun dispatch-route-by-name (name request &optional params)
(defun dispatch-route-by-name (name request &optional old-params)
"Dispatch a route by its PATH and METHOD. Pass REQUEST to it."
(declare (ignorable old-params))
(with-slots (method headers)
request
(let* ((response (make-response))
(route (or (find-if (lambda (route) (equal name (route-name route))) *routes*)
(and *any-route-handler*
(eql method (route-method *any-route-handler*))
*any-route-handler*))))
(log:info *routes* route)
(parse-cookies headers request response)
(setf (request-data request) (append (request-data request) (list :params params)))
(%dispatcher route request response))))
(route (or (find-route-by-name name *routes*)
(and *any-route-handler*
(eql method (route-method *any-route-handler*))
*any-route-handler*)))
(found (or (match-route (request-uri request) (request-method request)) (cons route nil))))
(destructuring-bind (route . params)
found
(parse-cookies headers request response)
(setf (request-data request) (append (request-data request) (list :params params)))
(%dispatcher route request response)))))

(defun dispatch-route-by-route (route request)
"Dispatch a route by its PATH and METHOD. Pass REQUEST to it."
(with-slots (method headers)
request
(let* ((response (make-response))
(found (or (match-route (request-uri request) (request-method request) (list route))
(cons route nil))))
(destructuring-bind (route . params)
found
(parse-cookies headers request response)
(setf (request-data request) (append (request-data request) (list :params params)))
(%dispatcher route request response)))))

(defmacro route (name method path args &body body)
"Define a route with NAME for its function name, PATH to be requested and
Expand All @@ -207,3 +189,12 @@
(defun ,name ,args
,@body)
(add-route ',name ,path ,method #',name)))

(defun route-uri-of (route &optional args)
"Generate the uri of a ROUTE applying ARGS as parameters."
(concatenate 'string "/"
(str:join "/" (loop :for segment :in (matcher-segments (route-matcher route))
:if (char-equal #\: (aref segment 0))
:collect (format nil "~a" (pop args))
:else
:collect segment))))
1 change: 0 additions & 1 deletion routing/static.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,6 @@
(declare (ignorable request response))
(let* ((serving (concatenate 'string (namestring ,*static-path*) ,path))
(content (read-file-string serving)))
(log:info serving content)
(write-response response
:status 200
:content-type ,mime
Expand Down
Loading

0 comments on commit 144e4b3

Please sign in to comment.