path: root/bin/serve.fnl

(import-macros {: map : reduce : filter} :lib.macro)

(tset package :path (.. package.path ";./vendor/lpeglj/?.lua"))

(local math (require :math))
(local fennel (require :vendor.fennel))
(local html (require :vendor.html))
(local libhtml (require :lib.html))
(local array (require :lib.array))
(local str (require :lib.string))
(local texts (require :texts))
(local fs (require :lib.fs))
(local spellfix (require :lib.spellfix))
(local cache (require :lib.cache))
(local {: must} (require :lib.utils))

(when _G.unpack
 (tset table :unpack _G.unpack))

(set _G.reload
  (fn [module]
    (local old (require module))
    (tset package :loaded module nil)
    (local (ok? new) (pcall require module))
    (if (not ok?)
      (do
       (tset package :loaded module old)
       (error new))
      (when (= (type new) :table)
       (do
        (each [k v (pairs new)]
              (tset old k v))
        (each [k (pairs old)]
              (when (not (. new k))
                (tset old k nil)))
        (tset package :loaded module old))))))

(local db
  (must (luna.db.open "file:var/db.sqlite?_journal=WAL&_sync=NORMAL&_txlock=immediate")))

(local query-synonyms {
  "шэн" "шен"
  "шен" "шэн"
  "дянь" "дань"
  "дань" "дянь"
  "чжень" "чжэнь"
  "чжэнь" "чжень"
  "хун" "цун"
  "цун" "хун"
  "доска" "чабань"
  "лунцзин" "лун цзин"
  "лун цзин" "лунцзин"
  "билочунь" "би ло чунь"
  "би ло чунь" "билочунь"
  "чахай" "сливник"
  "сливник" "чахай"
  "чабань" "доска"
  "термос" "бутылка"
  "бутылка" "термос"})

(fn sanitize-input [input]
  (if input
    (str.trim (input:gsub "[=()<>']" "") " ")
    nil))

(fn query-string [query key]
  (if (and query
          (. query key)
          (. query key 1)
          (< 0 (# (. query key 1))))
    (sanitize-input (. query key 1))
    nil))

(fn query-number [query key]
  (if (and query
           (. query key)
           (. query key 1)
           (< 0 (# (. query key 1))))
    (tonumber (sanitize-input (. query key 1)))
    nil))

(fn serialize-query [query]
  (local flattened-object
    (collect [k v (pairs query)]
      (values k (array.join (map (fn [_ vv] (.. k "=" vv)) v) "&"))))
  (array.join (array.list flattened-object) "&"))

(fn collect-form [params]
  {:query (or (query-string params "query") "")
   :page (or (query-number params "page") 1)
   :tags (map #(sanitize-input $2)
              (filter #(~= "" $2) (or params.tags [])))
   :site (or (query-string params "site") "")
   :sort (or (query-string params "sort") "")
   :min-price (query-number params "min-price")
   :max-price (query-number params "max-price")
   :min-volume (query-number params "min-volume")
   :max-volume (query-number params "max-volume")
   :price-per (= "on" (query-string params "price-per"))})

(fn form-empty? [form]
  (and
   (= "" form.query)
   (= (# form.tags) 0)
   (= "" form.site)
   (not form.min-price)
   (not form.max-price)
   (not form.min-volume)
   (not form.max-volume)
   ;; price-per and sort are intentionally left out since they must not
   ;; trigger search by itself
   ))

(fn form->path [page form]
  (.. "?page=" (tostring page)
      (if (not (str.empty? form.query))
        (.. "&query=" form.query)
        "")
      (if (< 0 (# form.tags))
        (.. "&"
            (array.join
              (array.flatten
                (map (fn [_ tag] (.. "tags=" tag))
                     form.tags))
              "&"))
        "")
      (if (not (str.empty? form.site))
        (.. "&site=" form.site)
        "")
      (if (and form.min-price (< 0 form.min-price))
        (.. "&min-price=" (tostring form.min-price))
        "")
      (if (and form.max-price (< 0 form.max-price))
        (.. "&max-price=" (tostring form.max-price))
        "")
      (if form.price-per
        "&price-per=on"
        "")
      (if (and form.min-volume (< 0 form.min-volume))
        (.. "&min-volume=" (tostring form.min-volume))
        "")
      (if (and form.max-volume (< 0 form.max-volume))
        (.. "&max-volume=" (tostring form.max-volume))
        "")
      (if form.sort
        (.. "&sort=" form.sort)
        "")))

(fn teas-of-the-day [limit]
  (assert (< 0 limit) "limit must be > 0")
  (local the-number (* (tonumber (os.date "%Y%m%d")) limit))
  (local total
    (. (must (luna.db.query db
               "SELECT count(ROWID)
                FROM (
                 SELECT products.ROWID
                 FROM products
                 INNER JOIN product_tags ON product_tags.product = products.url
                 WHERE archived = false
                 AND product_tags.tag IN ('Красный чай', 'Улун', 'Шен пуэр',
                                          'Шу пуэр', 'Зеленый чай', 'Белый чай',
                                          'Желтый чай')
                 GROUP BY products.url)" []))
       1 1))
  (must
    (luna.db.query-assoc
      db
      "SELECT products.site,
              products.title,
              products.description,
              products.image,
              products.url,
              products.price,
              products.weight,
              products.price_per AS \"price-per\"
       FROM products
       INNER JOIN product_tags ON product_tags.product = products.url
       WHERE products.archived = false
       AND product_tags.tag IN ('Красный чай', 'Улун', 'Шен пуэр', 'Шу пуэр',
                                'Зеленый чай', 'Белый чай', 'Желтый чай')
       GROUP BY products.url
       ORDER BY ROW_NUMBER() over (PARTITION BY site ORDER BY products.ROWID)
       LIMIT ?
       OFFSET ?"
      [limit (% the-number (- total limit))])))

(fn now []
  (os.date "%Y-%m-%d %H:%M:%S"))

(fn store-metric [headers url]
  (local fingerprint
    (must (luna.crypto.sha1
            (.. (or headers.User-Agent "") ":"
                (or headers.X-Forwarded-For
                    headers.Forwarded
                    headers.X-Real-Ip
                    "")))))
  (must
   (luna.db.exec
     db
     "INSERT INTO metrics(fingerprint, url, creation_time) VALUES (?, ?, ?)"
     [fingerprint url (now)])))

(fn tracked-url [url]
  (.. "/track?url=" (must (luna.http.encode-url url))))

(fn all-tags []
  (map
    (fn [_ v] (. v 1))
    (must
     (luna.db.query
      db
      "SELECT DISTINCT tags.title FROM tags
       INNER JOIN product_tags ON product_tags.tag = tags.title
       ORDER BY creation_time" []))))

(fn shops-count []
  (# (must (luna.db.query db
             "SELECT DISTINCT site
              FROM products
              WHERE archived = false" []))))

(fn products-count []
  (. (must (luna.db.query db
             "SELECT DISTINCT COUNT(url)
              FROM products
              WHERE archived = false" []))
     1 1))

(fn latest-update-date []
  (. (must (luna.db.query db
             "SELECT creation_time
              FROM products
              ORDER BY creation_TIME DESC
              LIMIT 1" []))
     1 1))

(fn query-products [{: query : tags : min-price : max-price : price-per
                     : min-volume : max-volume : site : sort} page]
  (local tags (or tags []))
  (local where-conds [])
  (local sort-criteria [])
  (local query-args [])

  ;; create WHERE clause from dynamic form parameters
  (when (< 0 (# tags))
    (each [_ tag (pairs tags)]
      (table.insert where-conds "product_tags.tag = ?")
      (table.insert query-args tag)))
  (when (and query (< 0 (# query)))
    (table.insert where-conds "search.title MATCH ?")
    (table.insert query-args
      (array.join
        (map (fn [_ q]
               (local lower-q (must (luna.utf8.lower q)))
               (if (. query-synonyms lower-q)
                 (.. "(" q "* OR " (. query-synonyms lower-q) "*)")
                 (.. q "*")))
             (str.split query " "))
        " AND ")))
  (when (not (str.empty? site))
    (table.insert where-conds "products.site = ?")
    (table.insert query-args site))
  (when (and min-price (< 0 min-price))
    (if price-per
      (table.insert where-conds "products.price_per >= ?")
      (table.insert where-conds "products.price >= ?"))
    (table.insert query-args min-price))
  (when (and max-price (< 0 max-price))
    (if price-per
      (table.insert where-conds "products.price_per <= ?")
      (table.insert where-conds "products.price <= ?"))
    (table.insert query-args max-price))
  (when (and min-volume (< 0 min-volume))
    (table.insert where-conds "products.volume >= ?")
    (table.insert query-args min-volume))
  (when (and max-volume (< 0 max-volume))
    (table.insert where-conds
                  "(products.volume <= ? AND products.volume != 0)")
    (table.insert query-args max-volume))

  (local where-sql
    (if (< 0 (# where-conds))
      (.. "AND   " (array.join where-conds "\nAND "))
      ""))

  ;; create SORT clause from dynamic form parameters
  (when sort
    (if (= sort "cheap-first")
      (table.insert sort-criteria
        ;; multiple price by 100 if we only know a price for 1 gram
        "CASE WHEN products.weight = 1 THEN products.price * 100
              ELSE products.price
         END ASC")
     (= sort "expensive-first")
      (table.insert sort-criteria
        ;; multiple price by 100 if we only know a price for 1 gram
        "CASE WHEN products.weight = 1 THEN products.price * 100
              ELSE products.price
         END DESC")))
  (local sort-sql
    (if (< 0 (# sort-criteria))
      (.. (array.join sort-criteria ",\n") ",")
      ""))

  (local total
   (must
    (luna.db.query
     db
     (string.format
       "SELECT count(ROWID)
        FROM (
         SELECT products.ROWID
         FROM search
         INNER JOIN products ON search.fid = products.url
         LEFT JOIN product_tags ON product_tags.product = search.fid
         WHERE search.`table` = 'products'
         AND   products.archived = false
         %s
         GROUP BY products.url)" where-sql)
     query-args)))

  {:results
   (must
    (luna.db.query-assoc
     db
     (string.format
       "SELECT products.title,
               products.site,
               products.description,
               products.image,
               products.url,
               products.price,
               products.weight,
               products.price_per AS \"price-per\"
       FROM search
       INNER JOIN products ON search.fid = products.url
       LEFT JOIN product_tags ON product_tags.product = products.url
       WHERE search.`table` = 'products'
       AND   products.archived = false
       %s
       GROUP BY products.url
       ORDER BY %s
                ROW_NUMBER() over (PARTITION BY products.site ORDER BY products.ROWID),
                rank
       LIMIT 24 OFFSET ?" where-sql sort-sql)
     (array.concat query-args [(* (- page 1) 24)])))
   :total (if (< 0 (# total))
           (. total 1 1)
           0)})

(fn site-name-template [name]
  (local module (require (.. "parser." name)))
  [:a {:class "site-icon"
       :href (tracked-url (.. module.url "?from=everytea.ru"))}
   [:img {:src (.. "/static/" name ".webp") :alt (.. "Логотип " module.title)}]
   module.title])

(fn item-template [product]
  (local link (tracked-url (.. product.url "?from=everytea.ru")))
  [:div {:class "tile"}
   [:a {:href link :class "img-link" :rel "nofollow"}
    [:img {:class "img" :src product.image :title product.title
           :alt product.title} ""]]
   (site-name-template product.site)
   [:a {:href link :style "text-decoration: none;" :rel "nofollow"}
    [:NO-ESCAPE (.. "<div class=\"title\">"
                    (libhtml.unescape product.title)
                    "</div>")]]
   [:div {:class "price"}
    (if product.price (.. (str.format-price product.price) "₽") "")
    (if (< 0 product.weight)
      [:NO-ESCAPE (.. "за&nbsp;" product.weight "&nbsp;гр.")]
      "")
    (if (and (< 1 product.weight)
             product.price-per
             (< 0 product.price-per))
     [:NO-ESCAPE (.. "<br> (" (str.format-price product.price-per)
                     "₽ за&nbsp;1&nbsp;гр.)")]
     "")]])

(fn paginator-template [form page limit total max-numbers]
  (local last-page (math.ceil (/ total limit)))
  (local radius (math.floor (/ (- max-numbers 4) 2)))
  (local number-items
    (if (<= last-page max-numbers)
      (faccumulate [res [:span {}] i 1 last-page]
       (do
         (table.insert
           res [:a {:href (form->path i form)
                    :class (if (= page i) "paginator-active" "")}
                (tostring i)])
         res))
      [:span {}
       (table.unpack
        (array.concat
          (if (< (+ 1 radius) page)
            [[:a {:href (form->path 1 form)} "1"]
             (if (< (+ 2 radius) page) "…" "")]
            [])
          (faccumulate [res [] i (math.max 1 (- page radius))
                                 (math.min last-page (+ page radius))]
           (do
             (table.insert
               res [:a {:href (form->path i form)
                        :class (if (= page i) "paginator-active" "")}
                    (tostring i)])
             res))
          (if (< radius (- last-page page))
            [(if (< (+ 1 radius) (- last-page page)) "…" "")
             [:a {:href (form->path last-page form)} (tostring last-page)]]
            [])))]))

  (if (< limit total)
    [:div {:class "paginator"}
     [:div {:class "paginator-numbers"} number-items]
     [:div {} "Всего: " [:strong {} (string.format "%d" total)]]]
    ""))

(fn menu-template [path extra-class]
  (local item
    (fn [item-path title]
      [:a {:href item-path
           :class (if (= path item-path) "active" "")}
          title]))
  [:nav {:class (.. "menu" (if (str.empty? extra-class)
                             ""
                             (.. " " extra-class)))}
   (item "/red-tea" "Красный чай")
   (item "/sheng-puer" "Шен пуэр")
   (item "/shou-puer" "Шу пуэр")
   (item "/oolong" "Улун")
   (item "/green-tea" "Зеленый чай")
   (item "/white-tea" "Белый чай")
   (item "/yellow-tea" "Желтый чай")
   (item "/teaware" "Посуда")])

(fn aside-template [form path aside-content]
  (local teaware? (array.contains form.tags "Посуда"))

  [:aside {:class "aside"}
   [:div {:class "aside-content"}
    (if (or (not (form-empty? form)) (~= path "/"))
      [:a {:href "/" :style "display: block;"}
       [:img {:class "logo" :src "/static/logo.svg"
              :alt "Логотип everytea.ru" :title "Логотип everytea.ru"}]]
       [:img {:class "logo" :src "/static/logo.svg"
              :alt "Логотип everytea.ru" :title "Логотип everytea.ru"}])
    (menu-template path "menu-mobile")
    [:form {:class "form"}
     [:input {:type :search :name "query" :value form.query
              ;; autofocus makes browser scroll up to the input on reloads
              ;; and that doesn't work well with _G.reload
              :autofocus (if luna.debug nil true)
              :placeholder "Поисковый запрос"}]
     [:div {}
      [:select {:name "tags"}
        [:option {:value ""} "~ Тег ~"]
        (table.unpack
          (map
            (fn [_ tag]
                [:option {:value tag
                          :selected (if (array.contains form.tags tag)
                                        "selected" nil)}
                tag])
            (all-tags)))]]
     [:div {:class "form-range"}
      [:input {:type :number :name "min-price" :min "1"
               :placeholder "От ₽" :value (tostring form.min-price)}]
      [:input {:type :number :name "max-price" :min "1"
               :placeholder "До ₽" :value (tostring form.max-price)}]]
     (if teaware?
      [:div {:class "form-range"}
       [:input {:type :number :name "min-volume" :min "1"
                :placeholder "От мл" :value (tostring form.min-volume)}]
       [:input {:type :number :name "max-volume" :min "1"
                :placeholder "До мл" :value (tostring form.max-volume)}]]
      "")
     (if (not teaware?)
      [:div {:class "form-price-per"}
       [:input {:type :checkbox :id "price-per" :name "price-per"
                :checked (if form.price-per "checked" nil)}]
       [:label {:for "price-per"} "цена за грамм"]]
      "")
     [:div {}
      [:select {:name "site"}
       [:option {:value ""} "~ Сайт ~"]
        (table.unpack
          (map
            (fn [_ val]
              [:option {:value val
                        :selected (if (= form.site val) "selected" nil)}
                       (. (require (.. "parser." val)) :title)])
            [:ozchai :suhexuan :ozchai :kolokolnikovchai :tea108 :ipuer
                     :clubcha :daochai :chaekshop :teaworkshop :artoftea
                     :moychay :gorkovchay]))]]
     [:div {}
      [:select {:name "sort"}
       [:option {:value ""} "~ Порядок ~"]
       [:option {:value "cheap-first"
                 :selected (if (= form.sort "cheap-first") "selected" nil)}
         "Сначала дешевле"]
       [:option {:value "expensive-first"
                 :selected (if (= form.sort "expensive-first") "selected" nil)}
         "Сначала дороже"]]]
     [:button {:type :submit} "Искать"]]
    (if aside-content aside-content "")]])

(fn home-template []
  [:div {}
   [:article {:class "description"}
    [:h1 {} "Добро пожаловать!"]
    [:div {:class "description-text text"}
     [:p {} [:NO-ESCAPE
              (string.format texts.home-text
                             (shops-count)
                             (products-count)
                             (latest-update-date))]]]]
   (comment [:section {}
    [:h2 {} "Чаи дня"]
    [:div {:class "list"}
     (table.unpack (map #(item-template $2) (teas-of-the-day 10)))]])])

(fn base-template [form path content aside-content]
  (local title (if (str.empty? form.query)
                 texts.meta-title
                 (.. form.query " | " texts.meta-title)))
  (local canonical-url (str.trim (.. "https://everytea.ru" path) "/"))

  [:html {:lang "ru-RU"}
   [:head {}
    [:meta {:charset "utf-8"}]
    [:meta {:name "viewport"
            :content (.. "width=device-width,initial-scale=1,"
                          "minimum-scale=1.0,maximum-scale=5.0")}]
    ;; opengraph
    [:meta {:property "og:title" :content title}]
    [:meta {:property "og:description" :content texts.meta-description}]
    [:meta {:property "og:type" :content "website"}]
    [:meta {:property "og:url" :content canonical-url}]
    [:meta {:property "og:image"
            :content "https://everytea.ru/static/og:image.png"}]
    [:meta {:property "twitter:image"
            :content "https://everytea.ru/static/og:image.png"}]
    [:meta {:property "vk:image"
            :content "https://everytea.ru/static/og:image.png"}]
    [:meta {:property "og:image:width" :content "1200"}]
    [:meta {:property "og:image:height" :content "630"}]
    [:meta {:property "twitter:card" :content "summary_large_image"}]
    [:meta {:property "og:locale" :content "ru_RU"}]

    ;; inline styles so the page loads faster
    [:style {} [:NO-ESCAPE (fs.read-file "static/style.css")]]
    [:link {:rel "icon" :href "https://everytea.ru/static/favicon.svg"
            :type "image/svg+xml"}]
    [:link {:rel "preload" :fetchpriority "high" :as "image"
            :href "/static/logo-hor.svg" :type "image/svg+xml"}]
    [:link {:rel "canonical" :href canonical-url}]
    [:title {} title]
    [:meta {:name "description" :content texts.meta-description}]]
   [:body {}
    [:div {:class "container"}
     [:div {:class "content"}
      (aside-template form path aside-content)
      [:main {}
       (menu-template path)
       content
       [:footer {}
        [:small {:class "text"} [:NO-ESCAPE texts.footer-text]]]]]]]])

(fn root-handler [{: headers : path : query}]
  (local path-with-query (.. path "?" (serialize-query query)))
  ;; FIXME: do not run render-listing when cache is hit
  (local cache-key (.. "page:" path-with-query))
  (local cached (cache.get db cache-key))
  (store-metric headers path-with-query)

  (fn render-listing [form category]
    (local headers {:content-type "text/html"})
    (when (and category (= 0 (# form.tags)))
      (tset form.tags 1 category))

    (local {: results : total} (query-products form form.page))
    (local spellfix-suggestion
      (if (and (not (str.empty? form.query)) results (= 0 (# results)))
       (cache.wrap
         db (.. "spellfix:" form.query)
         #(spellfix.guess form.query))
       nil))

    (local description-key (.. (str.trim path "/") "-description"))
    (local page
      (base-template form path
       [:div {}
        (if (and (. form.tags 1) (. texts description-key))
         [:article {:class "description"}
          [:h1 {} (. form.tags 1)]
          [:div {:class "description-text text"}
          [:NO-ESCAPE (. texts description-key)]]]
         "")
        (if (< 0 (# results))
          [:div {:class "list"}
           (table.unpack (map #(item-template $2) results))]
          [:p {:class "text"}
           (if spellfix-suggestion
            [:NO-ESCAPE
              (string.format texts.no-results-with-suggestion
                             spellfix-suggestion
                             spellfix-suggestion)]
            [:NO-ESCAPE texts.no-results])])
        [:div {} (paginator-template form form.page 24 total 17)]]
       ;; aside
       (paginator-template form form.page 24 total 7)))

    (values
      200 headers
      (cache.set db cache-key
      (.. "<!DOCTYPE html>\n" (html.render page true)))))

  (if (and (not luna.debug) cached)
    (values 200 {:content-type "text/html"} cached)
    (do
     (local form (collect-form query))
     (match (str.split path "/")
       ["red-tea"] (render-listing form "Красный чай")
       ["sheng-puer"] (render-listing form "Шен пуэр")
       ["shou-puer"] (render-listing form "Шу пуэр")
       ["oolong"] (render-listing form "Улун")
       ["green-tea"] (render-listing form "Зеленый чай")
       ["white-tea"] (render-listing form "Белый чай")
       ["yellow-tea"] (render-listing form "Желтый чай")
       ["teaware"] (render-listing form "Посуда")
       (where t (= 0 (# t)))
         (if (form-empty? form)
          (values
           200 {:content-type "text/html"}
           (.. "<!DOCTYPE html>\n"
               (html.render (base-template form path (home-template))
                true)))
          (render-listing form))
       _ (values
          404 {:content-type "text/html"}
          (.. "<!DOCTYPE html>\n"
              (html.render
               (base-template form path [:div {} "Страница не найдена!"])
               true)))))))

(fn robots-handler []
  (values 200 {:content-type "text/plain"}
          "User-agent: *\nAllow: /"))

(fn track-handler [{: headers : query}]
  (local redirect-url (?. query :url 1))
  (if redirect-url
    (do
      (store-metric headers redirect-url)
      (values 307 {:Location redirect-url} ""))
    (values 400 {} "bad redirect url")))

(must (luna.router.route "GET /" root-handler))
(must (luna.router.route "GET /robots.txt" robots-handler))
(must (luna.router.static "GET /static/" "static/"))
(must (luna.router.route "GET /track" track-handler))

(when luna.debug
  (must (luna.on-eval (fn [code] (fennel.eval code {:env _G})))))