From 1f57aba424e8d11679ecb6dcc4892920a5906842 Mon Sep 17 00:00:00 2001 From: Craig Oates Date: Wed, 5 Jan 2022 23:28:08 +0000 Subject: [PATCH] Chapter 10 commit. This chapter focued on using foreign keys to reference other tables in the SQLite database. The multiple associate models code examples are all based on mito (the ORM) and, as always with ORM's, I always feel lost using them. So, I do not know how to sum this commit up apart from say Chapter 10 committed. --- rails-to-caveman.asd | 1 + src/model.lisp | 91 +++++++++++++--- src/web.lisp | 194 +++++++++++++++++++++++++++++++++- templates/entries/edit.html | 16 +++ templates/entries/footer.html | 20 ++++ templates/entries/form.html | 62 +++++++++++ templates/entries/index.html | 39 +++++++ templates/entries/new.html | 16 +++ templates/entries/show.html | 17 +++ templates/shared/header.html | 2 +- templates/shared/sidebar.html | 6 +- 11 files changed, 447 insertions(+), 17 deletions(-) create mode 100644 templates/entries/edit.html create mode 100644 templates/entries/footer.html create mode 100644 templates/entries/form.html create mode 100644 templates/entries/index.html create mode 100644 templates/entries/new.html create mode 100644 templates/entries/show.html diff --git a/rails-to-caveman.asd b/rails-to-caveman.asd index 2b98014..3b0fde3 100644 --- a/rails-to-caveman.asd +++ b/rails-to-caveman.asd @@ -11,6 +11,7 @@ #:uiop #:local-time ; <-- Added Chapter 6 #:ratify ; <-- Chapter 7 + #:trivia ; <-- Chapter 10 ;; for @route annotation #:cl-syntax-annot diff --git a/src/model.lisp b/src/model.lisp index 6c04484..340de0d 100644 --- a/src/model.lisp +++ b/src/model.lisp @@ -43,10 +43,9 @@ :accessor member-only)) (:metaclass mito:dao-table-class)) -(defun user-and-article-table-check () +(defun user-article-and-entry-table-check () (with-connection (db) - (mito:ensure-table-exists 'user) - (mito:ensure-table-exists 'article))) + (mito:ensure-table-exists '(user article entry)))) (defclass user () @@ -116,21 +115,30 @@ (write-line "hgoe hoge boge hoge") (write-line "fuga fuga guffaug uga") (write-line "tasdf asdf asdf sadf"))) - (now-time (local-time:now))) - (dotimes (x 10) - (mito:create-dao 'article - :title (format nil "Result:~D" x) - :body body - :date-released (local-time:timestamp- now-time (- 8 x) :day) - :date-expired (local-time:timestamp- now-time (- 2 x) :day) - :member-only (zerop 0))))))) + (now-time (local-time:now))) + (dotimes (x 10) + (mito:create-dao 'article + :title (format nil "Result:~D" x) + :body body + :date-released (local-time:timestamp- now-time (- 8 x) :day) + :date-expired (local-time:timestamp- now-time (- 2 x) :day) + :member-only (zerop 0))) + (dolist (name '("Jiro" "Taro" "Hana")) + (let ((user (mito:find-dao 'user :name name))) + (when user (dotimes (x 10) + (mito:create-dao 'entry + :user user + :title (format nil "Title~D" x) + :body body + :date-posted (local-time:timestamp- now-time (- 10 x) :day) + :status (nth (rem x 3) '("draft" "member-only" "public"))))))))))) (defun rebuild () "Drops the current database table, recreates it and populates it using seeded data." (with-connection (db) - (mito:recreate-table 'user) - (mito:recreate-table 'article)) + (mapc #'mito:ensure-table-exists '(user article entry)) + (mapc #'mito:recreate-table '(user article entry))) (seeds)) (defun ids () @@ -437,3 +445,60 @@ reference for future projects. This is a learning project after all. expired-hour expired-min))) ,@args))) + +(defclass entry() + ((user + :col-type user + :initarg :user + :accessor author-of + :reader author) + (title + :col-type (:varchar 200) + :initarg :title + :accessor title-of) + (body + :col-type (or :null :text) + :initarg :body + :accessor body-of) + (date-posted + :col-type :date + :initarg :date-posted + :accessor date-posted-of) + (status + :col-type (:varchar 16) + :initarg :status + :initform "draft")) + (:metaclass mito:dao-table-class)) + +(defmethod initialize-instance + :around((o entry) &rest args + &key posted-year + posted-month + posted-day + posted-hour + posted-min + date-posted + &allow-other-keys) + (apply #'call-next-method o + `(,@ (when (and (null date-posted) posted-year) + `(:date-posted ,(format nil "~A-~A-~AT~A:~A:00" + posted-year + posted-month + posted-day + posted-hour + posted-min))) ,@args))) + +(defmethod mito:delete-dao :before((user user)) + (mito:delete-by-values 'entry + :user-id (mito:object-id user))) + +(defun validate-entry (entry &rest target-slots) + (with-check-validate (entry) ;target-slots) + ((title (:require t) + (:type string) + (:assert (<= 1 (length title) 200))) + (body (:require t)) + (date-posted (:require t) + (:key #'local-time:parse-timestring)) + (status (:require t) + (:assert (find status '("draft" "member-only" "public"):test #'equal)))))) diff --git a/src/web.lisp b/src/web.lisp index 023bc2c..dfe4bcf 100644 --- a/src/web.lisp +++ b/src/web.lisp @@ -330,6 +330,175 @@ nil "/users/~D"(mito:object-id user)))))))) `(303 (:location ,(format nil "/user/~D" id)))))))))))) +(defroute ("/entries" :method :post) (&key method) + (cond ((string= "put" method) + (create-entry (lack.request:request-body-parameters + ningle:*request*))) + (t `(401 () (,(format nil "Unknown method ~S" method)))))) + +(defroute entries-index "/entries" (&key id) + (with-connection (db) + (let ((author (when id (mito:find-dao + 'rails-to-caveman.model::user :id id)))) + (format t "[INFO] ~A" author) + (render "entries/index.html" + `(:member ,author + :user ,(current-user) + :news ,(articles-make 5) + :blogs ,(entries :limit 5) + :articles ,(articles-make 5) + :entries ,(entries :author author) + ,@(roles) + :token ,(token) + ;; :member ,(rails-to-caveman.model::author-of entry)))))) + ))))) + +(defroute show-entry "/entries/:id" (&key id) + (if (null (ignore-errors (parse-integer id))) + (myway:next-route) + (with-connection (db) + (let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id id)) + (entries (entries :limit 5))) + (render "entries/show.html" + `(,@(roles) + :entry ,entry + :token ,(token) + :user ,(current-user) + :entries ,entries + :blogs ,entries + :news ,(articles 5) + :member ,(rails-to-caveman.model::author-of entry))))))) + +(defroute create-entry ("/entries" :method :post) ; :post was :put + (&key authenticity-token) + (step + (if (not (string= authenticity-token (token))) + '(401 () ("Denied")) + (with-connection (db) + (multiple-value-bind (entry errors) + (rails-to-caveman.model::validate-entry + (apply #'make-instance 'rails-to-caveman.model::entry + :user (current-user) + (request-params + (lack.request:request-body-parameters + ningle:*request*)))) + (if errors (render "entries/new.html" + `(,@(roles) + :entry ,entry + :token ,(token) + :errors ,errors + :user ,(current-user) + :blogs ,(entries :limit 5) + :news ,(articles 5))) + (progn (mito:save-dao entry) + (setf (gethash :notice ningle:*session*) + "Stored") + `(303 (:location + ,(format nil "/entries/~D" + (mito:object-id entry))))))))))) + +(defroute ("/entries/:id" :method :post) (&key method id) + (step + (cond ((string= "post" method) + (update-entry (acons "ID" id + (lack.request:request-body-parameters + ningle:*request*)))) + ((string= "delete" method) + (destroy-entry (acons "ID" id + (lack.request:request-body-parameters + ningle:*request*)))) + (t `(401 () (,(format nil "Unknown method ~S" method))))))) + +(defun update-entry (request) + (destructuring-bind (&key + authenticity-token + id + title + body + posted-year + posted-month + posted-day + posted-hour + posted-min + &allow-other-keys) + (request-params request) + (if (not (string= authenticity-token(token))) + '(401 ()("Denied")) + (if (null (ignore-errors (parse-integer id))) + (myway:next-route) + (with-connection (db) + (let ((entry (mito:find-dao + 'rails-to-caveman.model::entry :id id))) + (setf (rails-to-caveman.model::title-of entry) title + (rails-to-caveman.model::body-of entry) body + (rails-to-caveman.model::date-posted-of entry) + (format nil "~A-~A-~AT~A:~A:00" + posted-year + posted-month + posted-day + posted-hour + posted-min)) + (multiple-value-bind (entry errors) + (rails-to-caveman.model::validate-entry entry) + (if errors (render "entries/edit.html" + `(,@(roles) + :member ,(rails-to-caveman.model::author-of entry) + :user ,(current-user) + :token ,(token) + :entry ,entry + :news ,(articles 5) + :blogs ,(entries :limit 5) + :errors ,errors )) + (progn (mito:save-dao entry) + (setf (gethash :notice ningle:*session*) "Updated") + `(303 (:location + ,(format nil "/entries/~D" + (mito:object-id entry))))))))))))) + +(defroute "/entries/new" (&key) + (step + (render "entries/new.html" + `(,@(roles) + :token ,(token) + :entry ,(make-instance 'rails-to-caveman.model::entry + :date-posted + (local-time:now)) + :user ,(current-user) + :blogs ,(entries :limit 5) + :news ,(articles 5))))) + +(defroute "/entries/:id/edit" (&key id) + (if (null (ignore-errors (parse-integer id))) + (myway:next-route) + (render "entries/edit.html" + `(,@(roles) + :entry ,(with-connection (db) + (mito:find-dao 'rails-to-caveman.model::entry :id id)) + :user ,(current-user) + :blogs ,(entries :limit 5) + :news ,(articles 5))))) + +(defroute destroy-entry ("/entries/:id" :method :delete) + (&key authenticity-token id) + (if (not (string= authenticity-token (token))) + '(401 () ("Denied")) + (with-connection (db) + (if (null (ignore-errors (parse-integer id))) + (myway:next-route) + (let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id id))) + (if (null entry) + `(401 () (,(format nil "Entry id ~A is not exist" id))) + (progn (mito:delete-dao entry) + (setf (gethash :notice ningle:*session*) "Deleted") + `(303 (:location + ,(format nil "/user/~D/entries" + (mito:object-id (current-user)))))))))))) + +(defroute "/user/:id/entries" (&key id) + (entries-index (acons "ID" id + (lack.request:request-body-parameters + ningle:*request*)))) + (defroute "/account" () (if (not (hermetic:logged-in-p)) '(401 ()) @@ -558,7 +727,7 @@ nil "/users/~D"(mito:object-id user)))))))) ,@(roles) :token ,(token)))) -(defroute new-article ("/articles" :method :put) +(defroute new-article ("/articles" :method :put) ; :put need to be put? (&key authenticity-token no-expiration-p) (if (not (string= authenticity-token (token))) '(401 () ("Denied")) @@ -974,3 +1143,26 @@ nil "/users/~D"(mito:object-id user)))))))) ;; (:= :only-member your-app.model::+false+))) ;; (sxql:order-by(:desc :date-released)) ;; (sxql:limit n))))) + +(defun entries (&key (logged-in-p (hermetic:logged-in-p)) + (user (and logged-in-p (current-user))) + author limit) + (with-connection (db) + (mito:select-dao 'rails-to-caveman.model::entry + (sxql:where (trivia:match*(logged-in-p author) + ((nil nil) `(:= "public" :status)) + ((nil _) + `(:and (:= ,(mito:object-id author) :user-id) + (:= "public" :status))) + ((_ nil) `(:or (:= "public" :status) + (:= "member-only" :status) + (:and (:= "draft" :stats) + (:= ,(mito:object-id user) + :user-id)))) + ((_ _) (if(mito:object= user author) + `(:= ,(mito:object-id user) + :user-id) + `(:and (:= ,(mito:object-id author) :user-id) + (:or (:= "public" :status) + (:= "member-only" :status))))))) + (sxql:order-by (:desc :date-posted)) (when limit (sxql:limit limit))))) diff --git a/templates/entries/edit.html b/templates/entries/edit.html new file mode 100644 index 0000000..10760b0 --- /dev/null +++ b/templates/entries/edit.html @@ -0,0 +1,16 @@ +{% extends "layouts/app.html" %} + +{% block title %} +{% lisp (title! "Edit blog") %} +{% endblock %} + +{% block content %} +

{% lisp (title!) %}

+ +
+ + + {% include "entries/form.html" %} +
+
+{% endblock %} diff --git a/templates/entries/footer.html b/templates/entries/footer.html new file mode 100644 index 0000000..1e551a0 --- /dev/null +++ b/templates/entries/footer.html @@ -0,0 +1,20 @@ + diff --git a/templates/entries/form.html b/templates/entries/form.html new file mode 100644 index 0000000..eecc2c6 --- /dev/null +++ b/templates/entries/form.html @@ -0,0 +1,62 @@ +{% include "shared/errors.html" %} +

{{entry.date-posted}}

+ + + + + + + + + + + + + + + + + +
+ + + + - + + +
+
diff --git a/templates/entries/index.html b/templates/entries/index.html new file mode 100644 index 0000000..a717ab8 --- /dev/null +++ b/templates/entries/index.html @@ -0,0 +1,39 @@ +{% extends "layouts/app.html" %} +{% block title %} + +{% if member %} +{{ member.name +| lisp: (lambda (name) (title! (format nil "~A San's blog" name))) +}} +{% else %} + +{% lisp (title! "Member blog") %} + +{% endif %} +{% endblock %} + +{% block content %} + +

{% lisp (title!) %}

+ +{% if user %} +
+ Write blog +
+{% endif %} + +{% if entries %} +{% for entry in entries %} + +

{{entry.title}}

+

{{ entry.body | truncatechars: 80 }}

+More + +{% include "entries/footer.html" %} +{% endfor %} +{% else %} + +

No entries

+ +{% endif %} +{% endblock %} diff --git a/templates/entries/new.html b/templates/entries/new.html new file mode 100644 index 0000000..eaaa68e --- /dev/null +++ b/templates/entries/new.html @@ -0,0 +1,16 @@ +{% extends "layouts/app.html" %} + +{% block title %} +{% lisp (title! "Write new blog") %} +{% endblock %} + +{% block content %} +

{% lisp (title!) %}

+ +
+ + + {% include "entries/form.html" %} +
+
+{% endblock %} diff --git a/templates/entries/show.html b/templates/entries/show.html new file mode 100644 index 0000000..5951d33 --- /dev/null +++ b/templates/entries/show.html @@ -0,0 +1,17 @@ +{% extends "layouts/app.html" %} + +{% block title %} +{{ entry + | lisp: (lambda(entry) + (title! (format nil "~A - ~A San's blog" + (rails-to-caveman.model::title-of entry) + (rails-to-caveman.model::name-of (rails-to-caveman.model::author-of entry))))) + }} +{% endblock %} + +{% block content %} +

{% lisp (title!) %}

+

{{entry.title}}

+{{ entry.body | simple-format | safe }} +{% include "entries/footer.html" %} +{% endblock %} diff --git a/templates/shared/header.html b/templates/shared/header.html index e5caa90..26f7051 100644 --- a/templates/shared/header.html +++ b/templates/shared/header.html @@ -4,7 +4,7 @@