path: root/lib.fnl

(local secrets (require :secrets))

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

;; make macro out of it
(fn improve-typography [text]
  (var result
    (-> text
        (string.gsub  "(\n|\r)" " ")
        (string.gsub "%s+" " ")))
  (let [nbsp-replaces ["на" "На" "и" "И" "в" "В" "о" "О" "с" "С" "со" "Со" "до"
                       "До" "для" "Для" "а" "А" "но" "Но" "на" "На" "я" "Я" "мы"
                       "Мы" "над" "Над" "под" "Под" "г." "Г." "ул." "Ул."
                       "д." "Д." "%d+"]]
    (each [_ v (ipairs nbsp-replaces)]
      (set result
        (-> result
            (string.gsub (.. "( " v ") ") "%1 ")
            (string.gsub (.. "(%s" v ") ") " %1 ")
            (string.gsub (.. "^(" v ") ") "%1 ")))))
  result)

(fn test-improve-typography []
  (assert (= (improve-typography "Я лежу на пляжу!")
             "Я лежу на пляжу!"))
  (assert (= (improve-typography "500 рублей мы сняли со счета!")
              "500 рублей мы сняли со счета!"))
  (assert (= (improve-typography "500 рублей мы
                                  сняли со счета!")
             "500 рублей мы сняли со счета!")))

(fn starts-with? [str start]
  (= (string.sub str 1 (# start)) start))

(fn ends-with? [str end]
  (= (string.sub str (- (# end))) end))

(fn trim-left [str pattern]
  (local pattern (or pattern "%s"))
  (str:match (.. "^" pattern "*(.-)$")))

(fn trim-right [str pattern]
  (local pattern (or pattern "%s"))
  (str:match (.. "^(.-)" pattern "*$")))

(fn trim [str pattern]
  (local pattern (or pattern "%s"))
  (str:match (.. "^" pattern "*(.-)" pattern "*$")))

(fn file-exists? [path]
  (local f (io.open path "r"))
  (and (~= f nil) (io.close f)))

(fn parse-values [val]
  (assert (= (type val) "string") "val must be string")
  (accumulate [result {} k v (string.gmatch val "([%w-]+)=([%w-%%]+)")]
    (do
     (tset result k v)
     result)))

(fn handle-upload [db file description thumbnail-width]
  (local description (or description ""))
  ;; FIXME: check mimetype if we will allow uploads from users!
  (let [type (_G.must (luna.fs.mimetype file.path))
        sanitized-name (-> file.name
                         (string.gsub "^[%./\\]+" "")
                         (string.gsub "[^a-zA-Z0-9-_.]" "_")
                         (string.gsub "%.+" "."))
        final-name (.. (_G.must (luna.crypto.random-string 8)) "-" sanitized-name)
        thumbnail-name (.. "static/files/" final-name "-thumbnail.jpg")
        thumbnail (if thumbnail-width
                    (_G.must
                     (luna.image.create-thumbnail
                       file.path thumbnail-name thumbnail-width))
                    "")]
    (_G.must
     (luna.db.exec db
       "INSERT INTO files(name, creation_time, type, size, description, thumbnail)
        VALUES (?, ?, ?, ?, ?, ?)"
       [final-name (now) type file.size description thumbnail-name]))
    ;; FIXME: also handle file collisions
    (os.execute (.. "mv " file.path " ./static/files/" final-name))

    final-name))

(fn with-tx [db f]
  (let [tx (_G.must (luna.db.begin db))]
    (local (ok? result) (pcall f tx))
    (if ok?
      (do
        (luna.db.commit tx)
        result)
      (do
        (luna.db.rollback tx)
        (error result)))))

(fn empty-table? [t]
  (= (next t) nil))

(fn empty? [v]
  (or (= v nil) (= v "")))

(fn split [str delimiter]
  (assert delimiter "delimiter must be specified")
  (if (empty? str)
    []
    (do
      (local result {})
      (local len (# str))
      (var cursor 1)
      (var (start end) (str:find delimiter))
      (while start
        (when (< cursor start)
          (table.insert result (str:sub cursor (- start 1))))
        (set cursor (+ end 1))
        (set (start end) (str:find delimiter cursor)))
      (when (<= cursor len)
        (table.insert result (str:sub cursor len)))
      result)))

(fn concat [...]
  (local res [])
  (var cur 1)
  (each [_ t (pairs [...])]
   (each [_ v (pairs t)]
    (tset res cur v)
    (set cur (+ 1 cur))))
  res)

(fn merge [...]
  (local res [])
  (each [_ t (pairs [...])]
   (each [k v (pairs t)]
    (tset res k v)))
  res)

(fn append [t e]
  (table.insert t e)
  t)

(fn equal-tables? [t1 t2]
  (assert (= (type t1) "table") "t1 must be a table")
  (assert (= (type t2) "table") "t2 must be a table")

  (if (~= (# t1) (# t2))
    false
    (accumulate [res true
                 k1 v1 (pairs t1) &until (not res)]
      (and (. t2 k1) (= v1 (. t2 k1))))))

(fn string->number [str]
  (if str
    (tonumber (pick-values 1 (str:gsub "[^0-9.]" "")))
    nil))

(fn insert [str substr pos]
  (.. (str:sub 1 pos) substr (str:sub (+ 1 pos))))

(fn format-price [price]
  (var price-str (tostring price))
  (local dot-position (price-str:find "%."))
  (local price-len (if dot-position
                     (- (pick-values 1 dot-position) 1)
                     (# price-str)))
  (var cursor (- price-len 3))
  (while (< 0 cursor)
    (set price-str (insert price-str " " cursor))
    (set cursor (- cursor 3)))
  price-str)

(fn group-by [lines fields]
  (fn contains? [array needle]
    (var found? false)
    (each [_ v (ipairs array) &until found?]
      (when (= v needle) (set found? true)))
    found?)

  (if (= 0 (# lines))
    []
    (do
      (local result [])
      (var grouping-line (. lines 1))
      (tset grouping-line :rest [])

      (each [_ line (ipairs lines)]
        (each [_ field (ipairs fields) &until (= line grouping-line)]
          (when (~= (. grouping-line field) (. line field))
           (do
            (table.insert result grouping-line)
            (set grouping-line line)
            (tset grouping-line :rest []))))

        (var rest {})
        (each [key value (pairs line)]
          (when (not (contains? fields key))
            (tset rest key value)))
        (table.insert grouping-line.rest rest))

      (table.insert result grouping-line)
      result)))

(fn encode-url-values [vals]
  (table.concat
    (accumulate [result [] k v (pairs vals)]
      (do
        (table.insert result (.. k "=" (_G.must (luna.http.encode-url v))))
        result))
    "&"))

(fn notify [message]
  (local tg-api-url
    (.. "https://api.telegram.org/bot" secrets.telegram-bot-token "/sendMessage"))

  ;; TODO: test for non-200 responses and log them.
  (local response
    (_G.must
      (luna.http.request
        "POST" tg-api-url
        {:Content-Type "application/x-www-form-urlencoded"}
        (encode-url-values
          {:chat_id secrets.telegram-notification-user-id
           :text message
           :parse_mode "html"})))))

{: improve-typography
 : starts-with?
 : ends-with?
 : trim
 : trim-left
 : trim-right
 : file-exists?
 : parse-values
 : handle-upload
 : with-tx
 : append
 : equal-tables?
 : empty-table?
 : split
 : concat
 : merge
 : empty?
 : now
 : string->number
 : format-price
 : group-by
 : encode-url-values
 : notify}