lispy-education
/
rails-to-caveman
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

initial Chapter 14 commit (code is broken). 

I have lost control of the code base and motivation to clean it up at
this moment in time. I am going to leave the project in its current
state and move on to another project to take what I have learned and
apply it in a more focuses manner. I might come back to this repo. at
some point in the future but, if I do not, consider this project
broken and do not try to use it in any way.
master
Craig Oates 2 years ago
parent
3a3392bba7
commit
718e6daeb9
3 changed files with 98 additions and 27 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 101
      src/model.lisp
  2. 20
      src/web.lisp
  3. 4
      templates/entries/index.html

101
src/model.lisp
Unescape View File

@ -24,6 +24,17 @@
#:sex)) #:sex))
(in-package #:rails-to-caveman.model) (in-package #:rails-to-caveman.model)
(defclass vote()
((entry
:col-type entry
:initarg :entry
:accessor entry-of)
(user
:col-type user
:initarg :user
:accessor user-of))
(:metaclass mito:dao-table-class))
(defclass article () (defclass article ()
((title :initarg :title ((title :initarg :title
:col-type (:varchar 80) :col-type (:varchar 80)
@ -98,6 +109,26 @@
:inflate #'cl-pass:hash )) :inflate #'cl-pass:hash ))
(:metaclass mito:dao-table-class)) (:metaclass mito:dao-table-class))
(defmethod mito:delete-dao :before ((user user))
(mito:delete-by-values 'vote
:user-id(mito:object-id user))
(mito:delete-by-values 'entry
:user-id (mito:object-id user)))
(defmethod mito:delete-dao :before ((o entry))
(mito:delete-by-values 'vote
:entry-id (mito:object-id o))
(mito:delete-by-values 'entry-image
:entry-id (mito:object-id o)))
(defun votablep (entry user)
(and entry (not (mito:object= user (author-of entry)))
(null (mito:select-dao 'vote
(sxql:where
(:and
(:= :user-id (mito:object-id user))
(:= :entry-id (mito:object-id entry))))
(sxql:limit 1)))))
(defun ids () (defun ids ()
"Produces a list of all the Id's in the database. Part of Chapter 4 "Produces a list of all the Id's in the database. Part of Chapter 4
@ -538,8 +569,21 @@ reference for future projects. This is a learning project after all.
;; 'user' class definition highlighting this. ;; 'user' class definition highlighting this.
:administrator (zerop 0) :administrator (zerop 0)
:password "asagao!" :password "asagao!"
:filename (when (zerop x) "profile.png") :filename "profile.png" ; (when (zerop x) "profile.png")
:content-type (when (zerop x) "image/png"))) :content-type "image/png") ; (when (zerop x) "image/png"))
;; PROBLEM IS IN HERE....
(with-open-file (s (merge-pathnames #P"profile.png"
rails-to-caveman.config::*application-root*)
:element-type '(unsigned-byte 8))
(let ((vector (make-array
(file-length s)
:element-type '(unsigned-byte 8))))
(read-sequence vector s)
(rails-to-caveman.storage::write
(make-instance 'flex::vector-input-stream :vector vector) x "account"
(rails-to-caveman.storage::make-file :name "profile.png" :content-type "image/png"))
;; PROBLEM IS IN HERE....
)))
;; "#.(" is an ARRAY LITERAL. (Noted in 'Loving Common Lisp' book). ;; "#.(" is an ARRAY LITERAL. (Noted in 'Loving Common Lisp' book).
(let ((body #.(with-output-to-string (*standard-output*) (let ((body #.(with-output-to-string (*standard-output*)
(format t "Morning glory wins.~2%") (format t "Morning glory wins.~2%")
@ -555,27 +599,40 @@ reference for future projects. This is a learning project after all.
:date-expired (local-time:timestamp- now-time (- 2 x) :day) :date-expired (local-time:timestamp- now-time (- 2 x) :day)
:member-only (zerop 0))) :member-only (zerop 0)))
(dolist (name '("Jiro" "Taro" "Hana")) (dolist (name '("Jiro" "Taro" "Hana"))
;; replace here...
(let ((user (mito:find-dao 'user :name name))) (let ((user (mito:find-dao 'user :name name)))
(when user (dotimes (x 10) (when user (dotimes (x 10)
(mito:create-dao 'entry ;; (mito:create-dao 'entry
:user user ;; :user user
:title (format nil "Title~D" x) ;; :title (format nil "Title~D" x)
:body body ;; :body body
:date-posted (local-time:timestamp- now-time (- 10 x) :day) ;; :date-posted (local-time:timestamp- now-time (- 10 x) :day)
:status (nth (rem x 3) '("draft" "member-only" "public"))))))) ;; :status (nth (rem x 3) '("draft" "member-only" "public")))))))
(let ((entry (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")))))
(when (find x '(7 8))
(dolist (name '("John" "Mike" "Sophy"))
(let ((voter (mito:find-dao 'user :name name)))
(mito:create-dao 'vote :user voter :entry entry)))))))))) )))
;; PROBLEM IS IN HERE.... ;; PROBLEM IS IN HERE....
(with-open-file (s (merge-pathnames #P"profile.png" ;; (with-open-file (s (merge-pathnames #P"profile.png"
rails-to-caveman.config::*application-root*) ;; rails-to-caveman.config::*application-root*)
:element-type '(unsigned-byte 8)) ;; :element-type '(unsigned-byte 8))
(let ((vector (make-array ;; (let ((vector (make-array
(file-length s) ;; (file-length s)
:element-type '(unsigned-byte 8)))) ;; :element-type '(unsigned-byte 8))))
(read-sequence vector s) ;; (read-sequence vector s)
(rails-to-caveman.storage::write ;; (rails-to-caveman.storage::write
(make-instance 'flex::vector-input-stream :vector vector) 1 "account" ;; (make-instance 'flex::vector-input-stream :vector vector) 1 "account"
(rails-to-caveman.storage::make-file :name "profile.png" :content-type "image/png")) ;; (rails-to-caveman.storage::make-file :name "profile.png" :content-type "image/png"))
;; PROBLEM IS IN HERE.... ;; ;; PROBLEM IS IN HERE....
)))))) ;; ))))))
;; ))))
#| #|
(defun seeds() (with-open-file (s (merge-pathnames "profile.png" (defun seeds() (with-open-file (s (merge-pathnames "profile.png"
@ -600,6 +657,6 @@ reference for future projects. This is a learning project after all.
(defun rebuild () (defun rebuild ()
"Drops the current database table, recreates it and populates it using seeded data." "Drops the current database table, recreates it and populates it using seeded data."
(with-connection (db) (with-connection (db)
(mapc #'mito:ensure-table-exists '(user article entry)) (mapc #'mito:ensure-table-exists '(user article entry entry-image vote))
(mapc #'mito:recreate-table '(user article entry))) (mapc #'mito:recreate-table '(user article entry entry-image vote)))
(seeds)) (seeds))

20
src/web.lisp
Unescape View File

@ -416,7 +416,12 @@ nil "/users/~D"(mito:object-id user))))))))
:news ,(articles-make 5) :news ,(articles-make 5)
:blogs ,(entries :limit 5) :blogs ,(entries :limit 5)
:articles ,(articles-make 5) :articles ,(articles-make 5)
:entries ,(entries :author author) :entry ,(entries :author author)
:entries ,(loop :for entry :in (entries :limit 5)
:for votes = (mito:count-dao 'rails-to-caveman.model::vote
:entry-id (mito:object-id author))
:collect (cons author (and (< 0 votes) votes)))
;; (entries :author author)
,@(roles) ,@(roles)
:token ,(token) :token ,(token)
;; :member ,(rails-to-caveman.model::author-of entry)))))) ;; :member ,(rails-to-caveman.model::author-of entry))))))
@ -435,7 +440,10 @@ nil "/users/~D"(mito:object-id user))))))))
:user ,(current-user) :user ,(current-user)
:entries ,entries :entries ,entries
:blogs ,entries :blogs ,entries
:news ,(articles 5) :news ,(articles-make 5)
:articles ,(articles-make 5)
:images ,(mito:retrieve-dao 'rails-to-caveman.model::entry-image
:entry-id (mito:object-id entry))
:member ,(rails-to-caveman.model::author-of entry))))))) :member ,(rails-to-caveman.model::author-of entry)))))))
(defroute create-entry ("/entries" :method :post) ; :post was :put (defroute create-entry ("/entries" :method :post) ; :post was :put
@ -532,9 +540,12 @@ nil "/users/~D"(mito:object-id user))))))))
:entry ,(make-instance 'rails-to-caveman.model::entry :entry ,(make-instance 'rails-to-caveman.model::entry
:date-posted :date-posted
(local-time:now)) (local-time:now))
:entries ,(make-instance 'rails-to-caveman.model::entry
:date-posted
(local-time:now))
:user ,(current-user) :user ,(current-user)
:blogs ,(entries :limit 5) :blogs ,(entries :limit 5)
:news ,(articles 5))))) :news ,(articles-make 5)))))
(defroute "/entries/:id/edit" (&key id) (defroute "/entries/:id/edit" (&key id)
(if (null (ignore-errors (parse-integer id))) (if (null (ignore-errors (parse-integer id)))
@ -1205,6 +1216,7 @@ nil "/users/~D"(mito:object-id user))))))))
(defroute index-entry-image "/entries/:id/images" (&key id) (defroute index-entry-image "/entries/:id/images" (&key id)
(with-authenticity-check (:logged-in) (with-authenticity-check (:logged-in)
(with-connection (db)
(ensure-let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id id))) (ensure-let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id id)))
(let ((images (mito:retrieve-dao (let ((images (mito:retrieve-dao
'rails-to-caveman.model::entry-image 'rails-to-caveman.model::entry-image
@ -1219,7 +1231,7 @@ nil "/users/~D"(mito:object-id user))))))))
:token ,(token) :token ,(token)
:news ,(articles-make 5) :news ,(articles-make 5)
:articles ,(articles-make 5) :articles ,(articles-make 5)
:blogs ,(entries :limit 5) )))))) :blogs ,(entries :limit 5) )))))))
(defroute "/about" () (defroute "/about" ()
;; about.html should be in the /templates directory. ;; about.html should be in the /templates directory.

4
templates/entries/index.html
Unescape View File

@ -28,7 +28,9 @@
<h2>{{entry.title}}</h2> <h2>{{entry.title}}</h2>
<p>{{ entry.body | truncatechars: 80 }}</p> <p>{{ entry.body | truncatechars: 80 }}</p>
<a href="/entries/{{entry.id}}">More</a> <a href="/entries/{{entry.id}}">More</a>
{% if votes %}
<span class="vote">★{{votes}}</span>
{% endif %}
{% include "entries/footer.html" %} {% include "entries/footer.html" %}
{% endfor %} {% endfor %}
{% else %} {% else %}

Write Preview
Loading…
Cancel
Save