diff options
| -rw-r--r-- | src/main.lisp | 146 | ||||
| -rw-r--r-- | src/package.lisp | 3 |
2 files changed, 55 insertions, 94 deletions
diff --git a/src/main.lisp b/src/main.lisp index b956b0a..4097ee5 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -5,8 +5,7 @@ (defclass invite (db:store-object) ((code :reader invite-code - :initarg :code - :initform (error "invite code required") + :initform (uuid) :index-type bknr.indices:string-unique-index :index-reader invite-by-code) (from @@ -70,13 +69,13 @@ :accessor oneliner :initarg :oneliner :initform (error "Onliner required")) - (commands - :accessor oneliner-commands - :initarg :commands + (tags + :accessor oneliner-tags + :initarg :tags :initform nil :index-type bknr.indices:hash-list-index :index-initargs (:test 'equal) - :index-reader oneliners-by-command + :index-reader oneliners-by-tag :documentation "The commands that this oneliner principally involves.") (brief :accessor oneliner-brief @@ -106,11 +105,6 @@ :accessor flagged-by :initform nil :documentation "NIL or :anonymous or a CONTRIBUTOR object.") - (audited-by - :accessor audited-by - :initform nil - :documentation "NIL or a CONTRIBUTOR object. Indicates that a user - has approved of this oneliner.") (lockedp :accessor lockedp :initform nil @@ -118,6 +112,24 @@ admin priviliges can lock/unlock.")) (:metaclass db:persistent-class)) +(defmethod json:%to-json ((instance oneliner)) + (with-slots + (db::id oneliner tags brief description + created-at edited-at last-edited-by created-by + flagged-by audited-by lockedp) + instance + (json:with-object + (json:write-key-value "id" db::id) + (json:write-key-value "oneliner" oneliner) + (json:write-key-value "tags" tags) + (json:write-key-value "brief" brief) + (json:write-key-value "description" description) + (json:write-key-value "createdAt" created-at) + (json:write-key-value "editedAt" (if edited-at edited-at :null)) + (json:write-key-value "createdBy" (contributor-handle created-by)) + (json:write-key-value "isFlagged" (if (not (null flagged-by)) t :false)) + (json:write-key-value "isLocked" (if lockedp t :false))))) + (defclass query-results-page (db:store-object) ((limit :initarg :limit) @@ -282,24 +294,29 @@ (make-instance 'api-access :contributor contributor))) (defun make-new-oneliner (contributor plist) - (print (list :contributor contributor :plist plist)) (with-plist - (oneliner commands brief description) plist - (print (list oneliner commands brief description)) + (oneliner tags brief description) plist (unless brief (http-err 400 "Oneliner requires a breif description")) (unless oneliner (http-err 400 "Oneliner cannot be blank")) - (unless commands - (http-err 400 "This oneliner does not seem to involve any commands")) + (db:with-transaction () (make-instance 'oneliner :created-by contributor :description (or description "") - :commands commands + :tags tags :oneliner oneliner :brief brief)))) +(defun query-oneliners (&key tags notflagged limit) + ;; inefficient but easy to express + (let ((ols (oneliners-with-all-tags tags))) + (a:subseq* (if notflagged + (remove-if #'flagged-by ols) + ols) + 0 (or limit 10)))) + ;;; ROUTE VARIABLE AND PARAMATER PARSERS @@ -377,60 +394,22 @@ (make-new-oneliner (request-contributor) (lzb:request-body)) "true") -;; (defendpoint* :get "/search" ((commands a-csl) -;; (keywords a-csl ) -;; (limit an-int) -;; (pagekey a-page-key) -;; (nextpage a-boolean) -;; (notflagged a-boolean) -;; (onlyaudited a-boolean)) -;; () -;; "A search endpoint returning a JSON encoded array of Oneliner Entries. - -;; **Note**: either command or keywords are required. -;; " -;; (cond -;; (pagekey ; return page if present. -;; (to-json (fetch-next-page page))) - -;; ((or commands keywords) ; else search for oneliners -;; (let* ((limit -;; (or limit 10)) ;TODO: no magic numbers -;; (results -;; (query-oneliners :commands commands -;; :keywords keywords -;; :notflagged notflagged -;; :onlyaudited onlyaudited)) -;; (limited-results -;; (a:subseq* results 0 limit))) -;; (to-json -;; (if nextpage -;; (list -;; :page (make-next-page limit (nthcdr limit results)) -;; :oneliners limited-results) -;; (list :oneliners limited-results))))) - -;; (t ; else responde with 400 -;; (http-err 400)))) - -;; (defendpoint* :put "/oneliner/:oneliner object-with-id:" () (:auth t) -;; "Updates a oneliner entry in the wiki database." -;; (cond -;; (oneliner -;; (update-oneliner (request-contributor) -;; oneliner -;; (lzb:request-body)) -;; "true") -;; (t (http-err 404)))) - -;; (defendpoint* :post "/oneliner" () (:auth t) -;; "Adds a new oneliner entry to the wiki database." -;; (a:if-let (new-oneliner (add-oneliner-to-db (request-contributor) (lzb:request-body))) -;; "{}" ; dummy implementation -;; (http-err 400))) - -;; (defendpoint* :post "/auth" () () -;; "Requests an authorization token") +(defendpoint* :get "/search" ((tags a-csl) + (limit an-int) + (notflagged a-boolean)) + () + "A search endpoint returning a JSON encoded array of Oneliner Entries. + +**Note**: either command or keywords are required. +" + (if tags + (to-json + (list :oneliners (query-oneliners :tags tags + :notflagged notflagged + :limit limit))) + + (t ; else responde with 400 + (http-err 400)))) ;;; HELPERS @@ -512,28 +491,9 @@ names. NAME must be a symbol or a string." thereis (search word description :test #'char-equal)))) -(defun onliners-with-all-commands (commands) - (reduce #'intersection (mapcar #'oneliners-by-command commands))) - -(defun query-oneliners (&key commands keywords notflagged onlyaudited) - (print "in query-oneliners") - (print (list :commands commands :keywords keywords :notflagged notflagged :onlyaudited onlyaudited)) - nil) - -;; (defun query-oneliners (&key commands keywords notflagged onlyaudited) -;; (if commands -;; (remove-if-not -;; #$(and (not (and notflagged (flagged-by $ol))) -;; (or (not onlyaudited) (audited-by $ol)) -;; (or (null keywords) (oneliner-mentions-any $ol keywords))) -;; (oneliners-with-all-commands command)) -;; (remove-if-not -;; #$(and (not (and notflagged (flagged-by $ol))) -;; (or (not onlyaudited) (audited-by $ol))) -;; (oneliners-from-keywords keywords)))) - -;; (defun oneliners-from-keywords (keywords) -;; (error "TBD")) +(defun oneliners-with-all-tags (tags) + (reduce #'intersection (mapcar #'oneliners-by-tag tags))) + (defun to-json (thing) (let ((jonathan:*false-value* :false) diff --git a/src/package.lisp b/src/package.lisp index 279eb37..9575d3e 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -2,7 +2,8 @@ (:use :cl) (:local-nicknames (#:lzb #:lazybones) (#:a #:alexandria-2) - (#:db #:bknr.datastore)) + (#:db #:bknr.datastore) + (#:json #:jonathan)) (:import-from #:lazybones #:defendpoint* #:http-err)) |