(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))))