From be06811cd6a1f7db10585f3f738173549887237c Mon Sep 17 00:00:00 2001 From: Craig Oates Date: Sat, 1 Jan 2022 21:05:20 +0000 Subject: [PATCH] end of session commit. I'm finishing up at the studio. So, just checking in the changes mades so far.. so I can carry-on at home. --- rails-to-caveman.asd | 2 + src/config.lisp | 5 +- src/model.lisp | 96 ++++++++++---- src/view.lisp | 13 +- src/web.lisp | 216 +++++++++++++++++++++++++++++++- static/locale/ja-jp.lisp | 4 +- templates/articles/edit.html | 17 +++ templates/articles/form.html | 117 +++++++++++++++++ templates/articles/index.html | 40 ++++++ templates/articles/new.html | 14 +++ templates/articles/show.html | 37 ++++++ templates/index.html | 4 + templates/layouts/app.html | 7 +- templates/shared/errors.html | 2 +- templates/shared/header.html | 2 +- templates/shared/user_form.html | 2 +- 16 files changed, 533 insertions(+), 45 deletions(-) create mode 100644 templates/articles/edit.html create mode 100644 templates/articles/form.html create mode 100644 templates/articles/index.html create mode 100644 templates/articles/new.html create mode 100644 templates/articles/show.html diff --git a/rails-to-caveman.asd b/rails-to-caveman.asd index 067b578..aef781c 100644 --- a/rails-to-caveman.asd +++ b/rails-to-caveman.asd @@ -17,6 +17,8 @@ ;; HTML Template #:djula + #:3bmd ; for markdown (Ch.9) + #:cl-who ; for markup (Ch.9) ;; for DB #:mito ; <--- Added in Chapter 4. diff --git a/src/config.lisp b/src/config.lisp index f6ad242..7e00baf 100644 --- a/src/config.lisp +++ b/src/config.lisp @@ -1,10 +1,11 @@ (in-package #:cl-user) (defpackage rails-to-caveman.config - (:use #:cl - #:rails-to-caveman.locale) + (:use #:cl) (:import-from #:envy #:config-env-var #:defconfig) + (:import-from #:rails-to-caveman.locale + #:define-dictionary) (:export #:config #:*application-root* #:*static-directory* diff --git a/src/model.lisp b/src/model.lisp index 747fffe..ac923b8 100644 --- a/src/model.lisp +++ b/src/model.lisp @@ -23,45 +23,58 @@ #:sex)) (in-package #:rails-to-caveman.model) -(defclass user() - ((number :col-type - :integer - :initarg - :number +(defclass article () + ((title :initarg :title + :col-type (:varchar 80) + :accessor title-of) + (body :initarg :body + :col-type :text + :accessor body-of) + (date-released :initarg :date-released + :col-type :date + :accessor date-released-of) + (date-expired :initarg :date-expired + :col-type (or :null :date) + :accessor date-expired-of) + (member-only :initarg :member-only + :col-type :boolean + :initform "1" ; as NIL + :accessor member-only)) + (:metaclass mito:dao-table-class)) + +(defun user-and-article-table-check () + (with-connection (db) + (mito:ensure-table-exists 'user) + (mito:ensure-table-exists 'article))) + + +(defclass user () + ((number :col-type :integer + :initarg :number :accessor number-of) (name :col-type (:varchar 64) - :initarg - :name + :initarg :name :accessor name-of) (full-name :col-type (or (:varchar 128) :null) - :initarg - :full-name + :initarg :full-name :accessor full-name-of) (email :col-type (or :null :text) - :initarg - :email + :initarg :email :accessor email-of) (birthday :col-type (or :null :date) - :initarg - :birthday + :initarg :birthday :accessor birthday-of) - (sex :col-type - :integer - :initarg - :sex + (sex :col-type :integer + :initarg :sex :initform "1" ; <--- This! :accessor sex-of) - (administrator :col-type - :boolean - :initarg - :administrator + (administrator :col-type :boolean + :initarg :administrator :initform "1" ; as NIL. ; <--- This! :accessor administrator-of) - (password :col-type - :text - :initarg - :password + (password :col-type :text + :initarg :password :accessor password-of :inflate #'cl-pass:hash )) (:metaclass mito:dao-table-class)) @@ -95,13 +108,28 @@ ;; function. I have, also, left a note in the ;; 'user' class definition highlighting this. :administrator (zerop 0) - :password "asagao!"))))) + :password "asagao!")) + ;; "#.(" is an ARRAY LITERAL. (Noted in 'Loving Common Lisp' book). + (let ((body #.(with-output-to-string (*standard-output*) + (format t "Morning glory wins.~2%") + (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))))))) (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 'user) + (mito:recreate-table 'article)) (seeds)) (defun ids () @@ -352,3 +380,17 @@ reference for future projects. This is a learning project after all. (:assert (<= 1 sex 2))) (administrator (:require t) (:key (lambda(x) (zerop (parse-integer x))))))))) + +(defun validate-article (article &rest target-slots) + (with-check-validate (article) ; target-slots) + ((title (:require t) + (:type string) + (:assert (<= (length title) 80))) + (body (:require t) + (:type string) + (:assert (<= (length body) 2000))) + (date-released (:require t) + (:key #'local-time:parse-timestring)) + (date-expired (:key #'local-time:parse-timestring)) + (member-only (:require t) + (:key (lambda(x)(zerop(parse-integer x)))))))) diff --git a/src/view.lisp b/src/view.lisp index f7e1fbc..52f89d1 100644 --- a/src/view.lisp +++ b/src/view.lisp @@ -40,7 +40,8 @@ ;; Execute package definition (defpackage rails-to-caveman.djula - (:use #:cl) + (:use #:cl + #:3bmd) (:import-from #:rails-to-caveman.config #:config #:appenv @@ -49,7 +50,10 @@ #:rails-to-caveman.locale) (:import-from #:caveman2 #:url-for) - (:export #:title!) ; Added in Chapter 3 (Mockup section). + (:import-from #:cl-ppcre + #:regexp-replace-all) + (:export #:title! ; Added in Chapter 3 (Mockup section). + ) ) ;; in-package and let code added in Chapter 3, also. This is ;; preperation for Switching Layout Templates section. @@ -78,3 +82,8 @@ (rails-to-caveman.locale::find-acceptable-locale (rails-to-caveman.locale::parse-accept-language (rails-to-caveman.locale::accept-language)))) it)) + +(djula::def-filter :simple-format (it) + (with-output-to-string (s) + (3bmd:parse-string-and-print-to-stream + (ppcre:regex-replace-all #\newline it "
") s))) diff --git a/src/web.lisp b/src/web.lisp index 8752c66..7132a30 100644 --- a/src/web.lisp +++ b/src/web.lisp @@ -7,7 +7,8 @@ #:rails-to-caveman.db #:rails-to-caveman.model #:sxql - #:mito) + #:mito + #:cl-who) (:export #:*web*)) (in-package #:rails-to-caveman.web) @@ -33,9 +34,8 @@ ;; '(:message "This is not a message") ; Added Chapter 3. `(:numbers (1 2 3 4 5) - :token ,(token)) - ;; :alert "Bitchin") - )) + :token ,(token) + :alert "Bitchin"))) (defroute "/users/index"() (render "users/index.html" @@ -77,7 +77,7 @@ `(:user ,(current-user) :new-user ,(with-connection (db) (rails-to-caveman.model::validate-user - (make-instance 'rails-to-caveman.model::user))) + (make-instance 'rails-to-caveman.model::user))) :news (1 2 3 4 5) :blogs (1 2 3 4 5) ,@(roles) @@ -476,6 +476,201 @@ nil "/users/~D"(mito:object-id user)))))))) '(303 (:location "/"))) '(303 (:location "/"))))) +(defroute "/articles" () + ;; (format t "[INFO] ~A and ~%" articles) + (if (not (hermetic:logged-in-p)) + (render "/index.html" + `(:news (1 2 3 4 5) + :blogs (1 2 3 4 5) + :token ,(token) + :alert "Not logged in you muppet.")) + (render "articles/index.html" + `(:user ,(current-user) + :news (1 2 3 4 5) + :blogs (1 2 3 4 5) + :token ,(token) + :articles ,(with-connection (db) + (mito:retrieve-dao 'rails-to-caveman.model::article)) + ,@(roles))))) + +(defroute ("/articles" :method :post) (&key method) + (cond ((string= "put" method) (new-article + (lack.request:request-body-parameters ningle:*request*))) + (t `(401 () (,(format nil "Unknown method ~S" method)))))) + +(defroute "/articles/:id" (&key id) + (if (null (ignore-errors (parse-integer id))) + (myway.mapper:next-route) + (render "articles/show.html" + `(:article ,(with-connection (db) + (mito:find-dao 'rails-to-caveman.model::article :id id)) + ,@(roles) + :user ,(current-user) + :news (1 2 3 4 5) + :blogs (1 2 3 4 5))))) + +(defroute ("/articles/:id" :method :post)(&key method id) + (cond ((and (string= "post" method) + (ignore-errors(parse-integer id))) + (edit-article (acons "ID" id + (lack.request:request-body-parameters ningle:*request*)))) + ((and (string= "delete" method) + (ignore-errors(parse-integer id))) + (destroy-article (acons "ID" id + (lack.request:request-body-parameters ningle:*request*)))) + (t `(401()(,(format nil "Unknown method ~S"method)))))) + +(defroute destroy-article ("/article/:id" :method :delete) + (&key authenticity-token id) + (if (not (string= authenticity-token(token))) + '(401()("Denied")) + (if (not (hermetic:logged-in-p)) + '(403 () ("Denied")) + (if (null (ignore-errors (setf id (parse-integer id)))) + (myway.mapper:next-route) + (progn (with-connection (db) + (mito:delete-by-values 'rails-to-caveman.model::article :id id)) + `(303 (:location "/articles"))))))) + +(defroute "/articles/new" () + (render "articles/new.html" + `(:article ,(make-instance 'rails-to-caveman.model::article) + :user ,(current-user) + :new (1 2 3 4 5) + :blogs (1 2 3 4 5) + ,@(roles) + :token ,(token)))) + +(defroute new-article ("/articles" :method :put) + (&key authenticity-token + released-year + released-month + released-day + released-hour + released-min + expired-year + expired-month + expired-day + expired-hour + expired-min) + ;; (dev:peep ningle:*request*) + (force-output) + (if (not (string= authenticity-token (token))) + `(401 () ("Denied")) + (with-connection (db) + (let ((render-args `(:user ,(current-user) + ,@(roles) + :token ,(token) + :news (1 2 3 4 5) + :blogs (1 2 3 4 5))) + (now-time (local-time:now))) + (multiple-value-bind (article errors) + (rails-to-caveman.model::validate-article + (apply #'make-instance 'rails-to-caveman.model::article + :allow-other-keys t + ;; This deviates from Chapter 9's code because + ;; the new article form does not populate the + ;; date-released part of the form properly. So, + ;; to get around it, date-released is created + ;; here instead of it being passed in to this + ;; function as values to be parsed. + :date-released (format nil "~A-~A-~AT~A:~A:00" + (local-time:timestamp-year now-time) + (local-time:timestamp-month now-time) + (local-time:timestamp-day now-time) + (local-time:timestamp-hour now-time) + (local-time:timestamp-minute now-time)) + :date-expired (format nil "~A-~A-~AT~A:~A:00" + expired-year + expired-month + expired-day + expired-hour + expired-min) + (request-params (lack.request:request-body-parameters ningle:*request*)))) + (if errors + (step + (render "articles/new.html" + (list* :article article + :errors errors + render-args))) + (progn (mito:insert-dao article) + (setf (gethash :notice ningle:*session*) "Stored") + `(303 (:location + ,(format nil "/articles/~D" + (mito:object-id article))))))))))) + + +(defroute "/articles/:id/edit" (&key id) + (render "articles/edit.html" + `(:article ,(with-connection (db) + (mito:find-dao + 'rails-to-caveman.model::article :id id)) + :user ,(current-user) + ,@(roles) + :token ,(token) + :news (1 2 3 4 5) + :blogs (1 2 3 4 5)))) + +(defun edit-article (request) + (step + (destructuring-bind + (&key authenticity-token + id + title + body + released-min + released-hour + released-day + released-month + released-year + expired-min + expired-hour + expired-day + expired-month + expired-year + member-only + &allow-other-keys) + (request-params request) + (if (not (string= authenticity-token (token))) + '(401 () ("Denied")) + (if (not (hermetic:logged-in-p)) + '(403 () ("Denied")) + (let ((article (with-connection (db) + (mito:find-dao + 'rails-to-caveman.model::article :id id)))) + (setf (rails-to-caveman.model::title-of article) title + (rails-to-caveman.model::body-of article) body + (rails-to-caveman.model::date-released-of article) + (format nil "~A-~A-~AT~A:~A:00" + released-year + released-month + released-day + released-hour + released-min) + (rails-to-caveman.model::date-expired-of article) + (format nil "~A-~A-~AT~A:~A:00" + expired-year + expired-month + expired-day + expired-hour + expired-min) + (rails-to-caveman.model::member-only article) member-only) + (multiple-value-bind (article errors) + (rails-to-caveman.model::validate-article + (if errors (render "articles/edit.html" + `(:article ,article + :errors ,errors + :user ,(current-user) + ,@(roles) + :token ,(token) + :news (1 2 3 4 5) + :blogs (1 2 3 4 5))) + (progn (with-connection (db) + (mito:save-dao article)) + (setf (gethash :notice ningle:*session*) "Updated") + `(303 (:location ,(format nil "/articles/~D" + (mito:object-id article)))))))))))))) + (defroute "/about" () ;; about.html should be in the /templates directory. @@ -673,3 +868,14 @@ nil "/users/~D"(mito:object-id user)))))))) (mito:find-dao 'rails-to-caveman.model::user :id (gethash :id ningle:*session*)))) + +(defun date-options (&key (start 0) (end 0) (target start) labels) + (loop :for i + :upfrom start :to end + :collect (cl-who:with-html-output-to-string (*standard-output*) + ((:option + :value i + :selected (when (eql i target) "selected")) + (princ (if labels (aref labels i) i)))) + :into options + :finally (return (format nil "~{~A~%~}" options)))) diff --git a/static/locale/ja-jp.lisp b/static/locale/ja-jp.lisp index b9917bd..68cc5b7 100644 --- a/static/locale/ja-jp.lisp +++ b/static/locale/ja-jp.lisp @@ -9,4 +9,6 @@ ("Email" . "メールアドレス") ("Administrator" . "管理者") ("Create user" . "登録する") - ("is required" . "を入力してください。")) + ("is required" . "を入力してください。") + ("logged in" . "JAPANESE TRANSLATION -- NOT LOGGED IN") + ("Stored" . "the article is stored (the japanese version)")) diff --git a/templates/articles/edit.html b/templates/articles/edit.html new file mode 100644 index 0000000..5a9ccbe --- /dev/null +++ b/templates/articles/edit.html @@ -0,0 +1,17 @@ +{% extends "layouts/app.html" %} +{% block title %}{% lisp (title! "Edit article") %}{% endblock %} + +{% block content %} +

{% lisp (title!) %}

+ +

Go back article

+ +
+ + + {% include "articles/form.html" %} + +
+
+ +{% endblock %} diff --git a/templates/articles/form.html b/templates/articles/form.html new file mode 100644 index 0000000..213bebd --- /dev/null +++ b/templates/articles/form.html @@ -0,0 +1,117 @@ +{% include "shared/errors.html" %} + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + - + + +
+ + + + - + + +
Member only + + + +
diff --git a/templates/articles/index.html b/templates/articles/index.html new file mode 100644 index 0000000..a8dbfdc --- /dev/null +++ b/templates/articles/index.html @@ -0,0 +1,40 @@ +{% extends "layouts/app.html" %} +{% block title %}{% lisp (title! "List of articles") %}{% endblock %} + +{% block content %} +

{% lisp (title!) %}

+ +
Write new article
+ +{% if articles %} + + + + + + + + + + {% for article in articles %} + + + + + + {% endfor %} + +
titledateoperation
{{article.title}}{{ article.date-released + | date: ((:year 4)"/"(:month 2)"/"(:day 2)" "(:hour 2)":"(:min 2)) + }} + Edit| +
+ + + +
+
+{% else %} +

No articles

+{% endif %} +{% endblock %} diff --git a/templates/articles/new.html b/templates/articles/new.html new file mode 100644 index 0000000..5a993d5 --- /dev/null +++ b/templates/articles/new.html @@ -0,0 +1,14 @@ +{% extends "layouts/app.html" %} +{% block title %} {% lisp (title! "Making new article") %} {% endblock %} + +{% block content %} +

{% lisp (title!) %}

+ +
+ + + {% include "articles/form.html" %} + +
+
+{% endblock %} diff --git a/templates/articles/show.html b/templates/articles/show.html new file mode 100644 index 0000000..46e16e3 --- /dev/null +++ b/templates/articles/show.html @@ -0,0 +1,37 @@ +{% extends "layouts/app.html" %} +{% block title %}{{article.title}} - {% lisp (title!) %}{% endblock %} + +{% block content %} +

{{article.title}}

+ +{% if logged-in %} +
Edit
+{% endif %} + + + + + + + + + + + + + + + + + + + + + + +
Title{{article.title}}
Article{{ article.body | simple-format | safe }}
Released at{{ article.date-released | date: ((:year 4)"/"(:month 2)"/"(:day 2)" "(:hour 2)":"(:min 2)) }}
Expired at + {% if article.date-expired %} + {{ article.date-expired | date: ((:year 4)"/"(:month 2)"/"(:day 2)" "(:hour 2)":"(:min 2)) }} + {% endif %} +
Member only{% if article.member-only-p %}Is a member{% else %}Is not a member{% endif %}
+{% endblock %} diff --git a/templates/index.html b/templates/index.html index 8a0da31..6a6ee7a 100644 --- a/templates/index.html +++ b/templates/index.html @@ -15,6 +15,10 @@ {% block title %}Rails to Caveman2 Demo.{% endblock %} {% block content %} +{% if notice %} +

{{notice}}

+{% endif %} +{% include "shared/errors.html" %} - - {% include "shared/sidebar.html" %}