path: root/src/site.lisp

(defpackage #:vampire.site
  (:import-from #:lazybones #:defendpoint*)
  (:import-from #:spinneret #:with-html #:with-html-string #:deftag)
  (:local-nicknames
   (#:lzb #:lazybones)
   (#:client #:lazybones/client.parenscript)
   (#:json #:jonathan)
   (#:a #:alexandria-2)
   (#:util #:vampire.utilities)
   (#:control #:vampire.control)
   (#:model #:vampire.model)
   (#:api #:vampire.api))
  (:use #:cl))

(in-package #:vampire.site)

;;; APP

(lzb:provision-app ()
  :content-type "text/html")

;;; SPECIALS

;;; MACROS

(defmacro defpage
    (path (&key
             (title "")
             params
             (auth t auth-supplied-p)
             notauth
             setup)
     &body body)
  "PATH is a LAYZBONES ENDPOINT path, and can contain variables.

TITLE is a form that is evalued in the context of the current request,
including any bindings from the PATH or QUERY params.

PARAMS are optional query parameters, parsed like they would be for an
lazybones endpoint definition.

AUTH is an arbitrary expression evaluated in the context of current
request. If it returns null, then a 403 is returned. Otherwise the
body is returned.

SETUP is a form, evaluted after AUTH, but before the body expands. It
can do anything; e.g. setting headers.

BODY is SPINNERET code defining the body (but not the header) of a
page."
  `(defendpoint* :get ,path ,params ()
     ,(when auth-supplied-p 
        `(unless ,auth
           ,(if notauth notauth `(lzb:http-err 403))))
     ,setup
     (with-html-string
       (:doctype)
       (:head
        (:title ,title)
        (:meta :charset "UTF-8")
        (:meta :name "viewport" :content "width=device-width, initial-scale=1.0")
        (:link :rel "stylesheet" :href "/css/theme.css"))
       (:body
        ,@body))))

(defmacro defpage/session
    (path (&key (title "") params setup) &body body)
  `(defpage ,path (:title ,title :params ,params :setup ,setup
                   :auth (browser-session) :notauth (lzb:http-redirect "/login"))
     (header)
     ,@body))


(defmacro two-columns (col1 col2)
  "A Two-Column Layout Macro"
  `(with-html
     (:div :class "container two-cols"
           (:div ,col1)
           (:div ,col2))))

;;; HELPERS

(defun playlist-title-string (pl)
  (concatenate 'string "~ " (model:title pl)))

;;; REQUEST AUTH AND HELPERS

(defun can-view-playlist-p (pl)
  t)

;;; PAGE ELEMENTS

(deftag form (inputs attrs &key (button "submit"))
  `(progn
     (:form ,@attrs
            (progn ,@inputs)
            (:button :type "submit" ,button))))

(deftag col (content attrs &key class)
  (let ((class (if class (concatenate 'string "col " class) "col"))) 
    `(progn
       (:div :class ,class ,@attrs
             (progn ,@content)))))

(deftag row (content attrs &key class)
  (let ((class (if class (concatenate 'string "row " class) "row"))) 
    `(progn
       (:div :class ,class ,@attrs
             (progn ,@content)))))




(defun input (name placeholder &optional (type "text"))
  (with-html
    (:input
     :name name
     :placeholder placeholder
     :type type)))

(defun active-a (path text &key (class ""))
  "generates an A element that has the `active` class when PATH is the
path we're visiting"
  (with-html
    (let ((classes (if (string-equal path (lzb:request-path))
                       (str:join " " (list "active" class))
                       class)))
      (if (plusp (length classes))
          (:a :class classes :href path text)
          (:a :href path text)))))

;;; LOGIN PAGE

;;; HOME PAGE

;;; USER PAGE

;;; EXPLORE PAGE

;;; PLAYLIST PAGE

(defun ps-prev-track ()
  (ps:ps (ps:chain -vampire-control (play-previous-track))))

(defun ps-next-track ()
  (ps:ps (ps:chain -vampire-control (play-next-track))))

(defun ps-play/pause ()
  (ps:ps (ps:chain -vampire-control (toggle-playback))))

(defun ps-play-track (track-key)
  (ps:ps (ps:chain -vampire-control (play-track (ps:lisp track-key)))))

(defun previous-track-button ()
  (with-html
    (:button
     :class "audio-control-button"
     :id "previous-track"
     :onclick (:raw (ps-prev-track))
     "⏮")))

(defun next-track-button ()
  (with-html
    (:button
     :class "audio-control-button"
     :id "next-track"
     :onclick (:raw (ps-next-track))
     "⏭")))

(defun play/pause-button ()
  (with-html
    (:button
     :class "audio-control-button"
     :id "play-pause"
     :onclick (:raw (ps-play/pause))
     "⏯")))

(defun now-playing (pl)
  (with-html
    (:div :class "now-playing"
          (:img :id "now-playing-img" :src (model::playlist-cover-url pl))
          (row :class "playback-controls"
            (col
             (previous-track-button))
            (col
              (play/pause-button))
            (col
              (next-track-button))))))

(defun whos-responsible-for-this-travesty (pl)
  (with-html
    (:div (:p "people who made this list"))))

(defun playlist-comments (pl)
  (with-html
    (:div (:p "Comments feature coming soon..."))))

(defun playlist-track-item (track)
  "Generates a view of TRACK as it should appear in a list of tracks."
  (with-html
    (:li
     :class "track-list-item"
     :onclick (:raw (ps-play-track track))
     (:div
      (:span :class "track-title" (model:title track))
      (:span :class "track-duration" (write-to-string (model::duration track))))
     (when (and (stringp (model:artist track))
                (plusp (length (model:artist track))))
       (:div (:span :class "track-artist" (model:artist track)))))))

(defun playlist-tracks-view (playlist)
  (with-html
    (:ol
     :class "track-list"
     :id "track-list"
     (dolist (track (model:tracks playlist))
       (playlist-track-item track)))))

(defun playlist-title-view (playlist)
  (with-html
    (:h3 :class "playlist-title"
         (model:title playlist)
         " -- "
         (:span "playlist-duration"
                (util:secs-to-hms (model::playlist-duration playlist))))))

(defun playlist-control-app (playlist)
  (with-html
    (:script)))

(defparameter +vampire-session-cookie+ "SESSIONKEY")

(defun browser-session ()
  (a:when-let* ((token (lzb:request-cookie +vampire-session-cookie+))
                (session (model:lookup token)))
    (when (typep session 'model:session)
      session)))

(defun session-user ()
  (a:when-let (session (browser-session))
    (model:user session)))


(defun header ()
  (with-html
    (:header
     (:hgroup
      (:div :class "navbar2"
            (:div :class "right vsep-container"
                  (:a :class "vsep-item" :href "/about" "about")
                  (:a :class "vsep-item" :href "/logout" "logout"))
            (:h1 "⹋ V̷ † ̷A̷ ⸸ ̷M̷ † ̷P̷ ⸸ ̷I̷ † ̷R̷ ⸸ ̷E̷ ⹋")))
     (:hgroup
      (:nav
       (:div :class "navbar"
             (active-a "/you" "YOU")
             (active-a "/us" "US")
             (active-a "/tracks" "TRACKS")))))))


(defendpoint* :get "/" () ()
  (if (browser-session)
      (lzb:http-redirect "/you")
      (lzb:http-redirect "/login")))

(defun gibberish ()
  (with-html
    (:p
     "At the Reagan National Defense Forum in Simi Valley, California, on
Saturday, US Commerce Secretary Gina Raimondo issued a cautionary
statement to Nvidia, urging them to stop redesigning AI chips for
China that maneuver around export restrictions. \"We cannot let China
get these chips. Period,\" she said. \"We're going to deny them our
most cutting-edge technology.\" Fortune reports: Raimondo said
American companies will need to adapt to US national security
priorities, including export controls that her department has placed
on semiconductor exports. \"I know there are CEOs of chip companies in
this audience who were a little cranky with me when I did that because
you're losing revenue,\" she said. \"Such is life. Protecting our
national security matters more than short-term revenue.\" Raimondo
called out Nvidia Corp., which designed chips specifically for the
Chinese market after the US imposed its initial round of curbs in
October 2022. \"If you redesign a chip around a particular cut line
that enables them to do AI, I'm going to control it the very next
day,\" Raimondo said. Communication with China can help stabilize ties
between the two countries, but \"on matters of national security,
we've got to be eyes wide open about the threat,\" she said. \"This is
the biggest threat we've ever had and we need to meet the moment,\"
she said. Further reading: Nvidia CEO Says US Will Take Years To
Achieve Chip Independence")))

(defun playlist-page-url (pl)
  (format nil "/playlist/~a/~a"
          (model:key pl)
          (url-rewrite:url-encode (model:title pl))))

(defun playlist-card (pl)
  (with-html
    (:a
     :href (playlist-page-url pl)
     :class "card"
     (:img :src (model::playlist-cover-url pl))
     (:span 
         (model:title pl)))))

(defun user-playlists (lists)
  (with-html
    (:h2 "Your Playlists")
    (:div
     :class "playlists"
     (dolist (pl lists)
       (playlist-card pl)))))

(defun make-playlist-form ()
  (with-html
    (:h2 "Create a Playlist")
    (form :class "center" :button "Create" :method "POST" :action "/playlist"
      (input "title" "Playlist Title"))))

(defendpoint* :post "/playlist" ()
  (:auth #'browser-session :body-vars (title))
  (control:check-title title)
  (let ((pl (model:new-playlist (session-user) :title title)))
    (lzb:http-redirect (playlist-page-url pl))))

(defun invites-control ()
  (with-html
    (:h2 "Invite Friends")
    (:div
     (:p "Invites go here"))))


(defun password-reset-link ()
  (with-html
    (:div
     (:a :href "/reset-password" "Reset Password"))))

(defpage/session "/you" (:title "Vampire ~ Your Stuff")
  (:div 
   (row
     (col
       (user-playlists
        (print (model:playlists (session-user)))))
     (col
       (make-playlist-form)
       (invites-control)
       (password-reset-link)))))

(defpage/session "/us" (:title "Vampire ~ Our Playlists")
  (:div :class "container"))

(defpage/session "/tracks" (:title "Vampire ~ Track Library")
  (:div :class "container"))

(defpage/session "/about" (:title "Vampore ~ About")
  (:div :class "container"
        "to be done"))

(defpage/session "/library" (:title "Vampire ~ Track Library"))

(defpage "/login"
    (:title "Vampire - Login")
  (:div :class "container"
        (form :button "Login" :method "POST" :action "/login"
          (input "username" "User name")
          (input "password" "Password" "password"))
        (:a :href "/create-account" "Create Account")))

(defendpoint* :post "/login" () (:body-vars (username password))
  (a:if-let (user (model:login-user username password))
    (let ((session (model:make-session user)))
      (lzb:set-response-cookie
       +vampire-session-cookie+ (model:key session))
      (lzb:http-redirect "/"))
    (lzb:http-redirect "/login")))

(defpage "/create-account"
    (:title "Vampire - Create Account")
  (:div :class "container"
        (form :action "/create-account" :method "POST"
          (input "token" "Invite Token")
          (input "name" "Choose User Name")
          (input "password" "Choose a Passwrod" "password"))))


(defpage/session "/playlist/:pl control:a-playlist:/:a-title-if-you-want:"
    (:title (model:title pl))
  (:h1 (model:title pl))
  (row
    (col
      (row (now-playing pl))
      (row (whos-responsible-for-this-travesty pl))
      (row (playlist-comments pl)))
    (col
      (loop :repeat 10 :do 
        (:p "track listing or something" "-- " "track controls")
        (:hr)))))

;;; CSS

(defendpoint* :get "/css/theme.css" () ()
  (setf (lzb:response-header :content-type) "text/css")
  (lass:compile-and-write
   '(:let ((main-background "#343434")
           (main-textcolor "#dfdede")
           (active-color "#aabbcc")
           (active-background-color "#222222")
           (link-color "#aaddbb")
           (hover-color "#ddeeff")
           (hover-backround-color "black")
           (fringe-color "#aabbcc")
           (padding "5px")
           (bigger "1.7em"))
     (body
      :background #(main-background)
      :color #(main-textcolor))

     (a
      :color #(link-color))

     (header
      :font-size 1.1em)

     (.vsep-container
      :display inline
      :border-left 1px solid #(fringe-color)
      (.vsep-item
       :padding-right 4px
       :padding-left 4px
       :border-right 1px solid #(fringe-color)))
     
     (.right
      :float right)
     
     (.inline
      :display inline)

     (.navbar2
      :width 100%
      :overflow auto
      (h1
       :float left
       :width 100%
       :text-align center))

     (.center
      :margin auto
      :max-width 80%)
     
     (.navbar
      :width 100%
      :overflow auto 
      :border-bottom 1px solid #(fringe-color)
      (a
       :float left
       :width 33%
       :font-size #(bigger)
       :text-align center
       :text-decoration none)
      ((:and a :hover)
       :color #(hover-color)
       :background #(hover-backround-color))
      (a.active
       :background #(active-background-color)
       :color #(active-color)))

     (.row
      :justify-content space-evenly
      :display flex
      :flex-wrap wrap
      :width 100%)

     (.col
      :flex 1)

     (.playlists
      :display flex
      :justify-content space-around
      :flex-wrap wrap
      :width 100%)
     
     (.card
      :margin #(padding)
      :border 1px solid #(fringe-color)
      :width 200px
      :height 200px
      :display block)
     
     ((:or h1 h2)
      :width 80%
      :margin-left auto
      :margin-right auto
      :text-align center
      :border-bottom 1px dotted #(fringe-color))

     (img
      :margin-left 10%
      :max-height 80%
      :max-width 80%)

     (.now-playing
      :width 480px
      :height 480px
      :border 1px solid #(fringe-color))

     ((.playback-controls button)
      :border 1px solid #(fringe-color)
      :background #(main-background)
      :color #(fringe-color)
      :font-size 2em
      :margin-left 10%
      :width 80%)


     (:media "(max-width: 650px)"
      (.navbar
       (a
        :float none
        :display block
        :width 100%
        :text-align left)))


     (:media "(max-width: 800px)"
      (.row
       :display block)))))

;;; JAVASCRIPT

(defendpoint* :get "/js/vampire-api.js" () ()
  "Serves a javascript module called 'VampireApi'"
  (setf (lzb:response-header :content-type) "text/javascript")
  (client:generate-js
   (lzb:app 'vampire.api::vampire.api)))

(defendpoint* :get "/js/vampire-util.js" () ()
  "Serves a javascript module called"
  )

(defendpoint* :get "/js/vampire-app.js" () ()
  "Serves a javascript module called VampireApp."
  (setf (lzb:response-header :content-type) "text/javascript")
  (ps:ps
    (defmodule -vampire-app
      "vampire control app"
      
      (defprivate element
          (lambda (id)
            (ps:chain document (get-element-by-id id))))
      
      (defprivate stop-media-playback
          (lambda ()))
      
      (defprivate forward-one-track
          (lambda ()))
      
      (defprivate back-one-track
          (lambda ()))
      
      (defprivate start-media-playback
          (lambda ()))
      
      (defprivate media-now-playing-p
          (lambda ()))
      
      (defpublic play-next-track
          (lambda ()
            (stop-media-playback)
            (when (forward-one-track)
              (start-media-playback))))
      
      (defpublic play-previous-track
          (lambda ()
            (stop-media-playback)
            (when (back-one-track)
              (start-media-playback))))
      
      (defpublic toggle-playback
          (lambda ()
            (if (media-now-playing-p)
                (stop-media-playback)
                (start-media-playback))))
      
      (defpublic play-track
          (lambda (key)
            (stop-media-playback)
            (set-track-to key)
            (start-media-playback)))
      
      (defpublic load
          (lambda ()
            (ps:chain -vampire-api
                      (get-session-playlist (ps:chain -vampire-client (get-session)))
                      (then ))))
      ;; moocow
      )))