path: root/bin/serve.fnl

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

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

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

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

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

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

(fn unescape [s]
  (assert (= (type s) :string) "s must be string")
  (pick-values 1
   (-> s
    (string.gsub "&lt;" "<")
    (string.gsub "&gt;" ">")
    (string.gsub "&quot;" "\"")
    (string.gsub "&amp;" "&"))))

(fn category-menu-path [category]
  (. {"Красный чай" "red-tea"
      "Шен пуэр" "sheng-puer"
      "Шу пуэр" "shou-puer"
      "Улун" "oolong"
      "Зеленый чай" "green-tea"
      "Белый чай" "white-tea"
      "Желтый чай" "yellow-tea"
      "Посуда" "teaware"} category))

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

(fn get-query-number [query key]
  (if (and query
          (. query key)
          (. query key 1)
          (< 0 (# (. query key 1))))
    (tonumber (. 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 category]
  {:query (str.trim (or (get-query-string params "query") ""))
   :tags (filter #(~= "" $2) (or params.tags [category]))
   :site (str.trim (or (get-query-string params "site") ""))
   :min-price (get-query-number params "min-price")
   :max-price (get-query-number params "max-price")
   :price-per (= "on" (get-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)
    ;; price-per is  intentionally left out since it 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"
        "")))

(fn random-products [limit]
  (assert (< 0 limit) "limit must be > 0")
  (must
   (luna.db.query*
    db
    "SELECT site,
            title,
            description,
            image,
            url,
            price,
            weight,
            price_per AS \"price-per\",
            year
      FROM products
      ORDER BY RANDOM()
      LIMIT ?"
    [limit])))

(fn all-tags []
  (map
    (fn [_ v] (. v 1))
    (must
     (luna.db.query
      db
      "SELECT title FROM tags ORDER BY creation_time"
      []))))

(fn query-products [{: query : tags : min-price : max-price : price-per : site} page]
  (local tags (or tags []))

  (var where-conds [])
  (var where-vars [])
  (when (< 0 (# tags))
    (each [_ tag (pairs tags)]
      (table.insert where-conds "product_tags.tag = ?")
      (table.insert where-vars tag)))
  (when (and query (< 0 (# query)))
    (table.insert where-conds "search.title MATCH ?")
    (table.insert where-vars
      (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 where-vars 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 where-vars 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 where-vars max-price))

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

  (local total
   (must
    (luna.db.query
     db
     (string.format
       "SELECT count(*)
        FROM search
        INNER JOIN products ON search.fid = products.url
        LEFT JOIN product_tags ON product_tags.product = search.fid
        WHERE search.`table` = 'products'
        %s" where-sql)
     where-vars)))

  {:results
   (must
    (luna.db.query*
     db
     (string.format
       "SELECT highlight(search, 0, '<i>', '</i>') AS \"title\",
               products.site,
               products.description,
               products.image,
               products.url,
               products.price,
               products.weight,
               products.price_per AS \"price-per\",
               products.year,
               products.archived,
               products.creation_time AS \"creation-time\"
       FROM search
       INNER JOIN products ON search.fid = products.url
       LEFT JOIN product_tags ON product_tags.product = products.url
       WHERE search.`table` = 'products'
       %s
       ORDER BY rank
       LIMIT 48 OFFSET ?" where-sql)
     (array.concat where-vars [(* (- page 1) 48)])))
   :total (if (< 0 (# total))
           (. total 1 1)
           0)})

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

(fn item-template [product]
  [:div {:class "tile"}
   [:a {:href product.url :style "display: block;" :rel "nofollow"}
    [:img {:class "img" :src product.image :title product.title
           :alt product.title} ""]]
   (site-name-template product.site)
   [:a {:href product.url :style "text-decoration: none;" :rel "nofollow"}
    [:NO-ESCAPE (.. "<h2>" (unescape product.title) "</h2>")]]
   [:div {:class "price"}
    (if product.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 (.. " (" product.price-per "₽ за&nbsp;1&nbsp;гр.)")]
     "")]])

(fn paginator-template [form page limit total]
  (local last-page (math.ceil (/ total limit)))

  (if (< limit total)
    [:div {:class "paginator"}
     [:div {:class "paginator-numbers"}
      (if (< 1 page)
       [:a {:href (form->path (- page 1) form)} "←"]
       "")
      (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))
      (if (< page last-page)
       [:a {:href (form->path (+ page 1) form)} "→"]
       "")]
     [: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 paginator]
  [:aside {:class "aside"}
   [:div {:class "aside-content"}
    (if (not (form-empty? form))
      [:a {:href "/" :style "display: block;"}
       [:img {:class "logo" :src "/static/logo.svg"
              :alt "Логотип meicha.ru" :title "Логотип meicha.ru"}]]
       [:img {:class "logo" :src "/static/logo.svg"
              :alt "Логотип meicha.ru" :title "Логотип meicha.ru"}])
    (menu-template path "menu-mobile")
    [:form {:class "form"}
     [:input {:type :search :name "query" :value form.query
              :autofocus 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-price"}
      [: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)}]]
     [: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 :clubcha :ipuer :artoftea :chaekshop]))]]
     [:button {:type :submit} "Искать"]]
    paginator]])

(fn base-template [form path page total items]
  (local paginator (paginator-template form page 48 total))
  (local menu-path
   (if (and form.tags (< 0 (# form.tags)))
    (category-menu-path (. form.tags 1))
    nil))
  (local spellfix-suggestion
    (if (and (not (str.empty? form.query)) items (= 0 (# items)))
     (cache.wrap
       db (.. "spellfix:" form.query)
       #(spellfix.guess form.query))
     nil))

  [: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"}]
    [:link {:rel "stylesheet" :href "/static/style.css"}]
    [:link {:rel "icon" :href "/static/favicon.png"}]
    [:link {:rel "preload" :href "/static/logo-hor.svg"}]
    [:title {} (if (str.empty? form.query)
                 texts.meta-title
                 (.. form.query " | " texts.meta-title))]
    [:meta {:name "description" :content texts.meta-description}]]
   [:body {}
    [:div {:class "container"}
     [:div {:class "content"}
      (aside-template form path paginator)
      [:section {}
       (menu-template path)
       (if (. form.tags 1)
        [:h1 {} (. form.tags 1)]
        "")
       (if (and menu-path (. texts (.. menu-path "-description")))
         [:div {:class "description"}
          [:NO-ESCAPE (. texts (.. menu-path "-description"))]]
         "")
       (if (< 0 (# items))
        [:div {:class "list"}
         (table.unpack (map #(item-template $2) items))]
        (if spellfix-suggestion
          [:NO-ESCAPE
            (string.format texts.no-results-with-suggestion
                           spellfix-suggestion
                           spellfix-suggestion)]
          [:NO-ESCAPE texts.no-results]))
       [:footer {} paginator]]]]]])

(fn root-handler [{: path : query}]
  (local cache-key (.. "page:" path "?" (serialize-query query)))
  (local cached (cache.get db cache-key))
  (if cached
    (values 200 {:content-type "text/html"} cached)
    (do
      (fn respond [query category]
       (let [headers {:content-type "text/html"}
             page (or (get-query-number query "page") 1)
             form (collect-form query category)
             {: results : total}
               (if (not (form-empty? form))
                 (query-products form page)
                 {:total 48 :results (random-products 48)})]
         (values
           200 headers
           (cache.set db cache-key
            (.. "<!DOCTYPE html>\n"
                (html.render
                 (base-template form path page total results)
                 true))))))

      (match (str.split path "/")
        ["red-tea"] (respond query "Красный чай")
        ["sheng-puer"] (respond query "Шен пуэр")
        ["shou-puer"] (respond query "Шу пуэр")
        ["oolong"] (respond query "Улун")
        ["green-tea"] (respond query "Зеленый чай")
        ["white-tea"] (respond query "Белый чай")
        ["yellow-tea"] (respond query "Желтый чай")
        ["teaware"] (respond query "Посуда")
        [] (respond query)
        _ (values 404 {} "not found")))))

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

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