05ae2bfe |
(defpackage :redirector.graph
(:use :closer-common-lisp :graph-db)
(:export
#:site
#:short-name
#:shortens
#:init
#:lookup-site-by-abbreviation
#:url
#:description
#:with-db
#:all-abbreviations
#:name))
(in-package :redirector.graph)
(log:config :all :sane :d :nopretty :thread :daily "/var/tmp/graph.log")
(def-vertex site ()
((url :type string)
(description :type string))
:fwoar-shortener)
(def-vertex short-name ()
((name :type string))
:fwoar-shortener)
(def-edge shortens ()
()
:fwoar-shortener)
(defun init (path)
(let ((*graph* (or *graph*
(graph-db:make-graph :fwoar-shortener path))))
(graph-db:def-view shortens-by-abbrev :lessp (redirector.graph::shortens :fwoar-shortener)
(:map (lambda (shorten-edge)
(yield (name (lookup-vertex (from shorten-edge))) nil))))))
(defun all-abbreviations ()
(select (:flat t)
((?site ?abbrev))
(shortens ?abbrev ?site)))
(defun lookup-site-by-abbreviation (abbrev)
(declare (special abbrev))
(select (:flat t)
(?site)
(lisp ?abbrev-name abbrev)
(shortens ?abbrev ?site)
(is ?abbrev-name (name ?abbrev))))
(defmacro with-db ((path) &body body)
(alexandria:once-only (path)
`(let ((*graph* (or *graph*
(lookup-graph :fwoar-shortener)
(if (probe-file ,path)
(open-graph :fwoar-shortener ,path)
(init ,path)))))
,@body)))
(defpackage :redirector.main
(:import-from :araneus :define-controller :define-view :define-routes)
(:use :closer-common-lisp))
(in-package :redirector.main)
(define-controller abbreviation (params)
(redirector.graph:with-db ("/tmp/shortening-graph/")
(redirector.graph:lookup-site-by-abbreviation
(cdr (assoc :route params)))))
(define-view redirect ((model list))
(if model
`(302 (:Location ,(redirector.graph:url (car model)))
(""))
'(404 () ("not found..."))))
(define-controller list-abbreviations (params)
(redirector.graph:with-db ("/tmp/shortening-graph/")
(mapcar (fw.lu:destructuring-lambda ((site abbrev))
(with-accessors ((url redirector.graph:url)
(description redirector.graph:description)) site
(with-accessors ((name redirector.graph:name)) abbrev
(list url description name))))
(redirector.graph:all-abbreviations))))
(araneus:define-view list-abbreviations ((abbreviation-list list))
(redirector.graph:with-db ("/tmp/shortening-graph/")
(spinneret:with-html-string
(:html
(:head)
(:body
(:ul.shortcuts
(mapcar (fw.lu:destructuring-lambda ((url description name))
(:li.shortcut (:a :href (format nil "/r/~a" name)
(:span.abbrev name)
(:span.description description)
(:span.url url))))
abbreviation-list)))))))
(define-routes shortener-routes
(("/" :method :GET) (araneus:as-route 'list-abbreviations))
(("/r/:route" :method :GET) (araneus:compose-route (abbreviation) redirect)))
(defun main (&optional (path "/tmp/shortening-graph/"))
(redirector.graph:with-db (path)
(let ((app (make-instance 'ningle:<app>)))
(shortener-routes app)
(values (clack:clackup app)
app))))
|