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

(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 order-id [request]
  (let [cookies-header (. request.headers :Cookie)
        cookies (if cookies-header (parse-values cookies-header) {})]
    cookies.order))

(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 basket [db order-id]
  (local items
    (_G.must
     (luna.db.query-assoc
       db
       "SELECT order_lines.id,
               products.name,
               products.title,
               products.price_per AS \"price-per\",
               STRING_AGG(product_images.name, ',') AS \"images\",
               order_lines.quantity
        FROM order_lines
        INNER JOIN products ON products.name = order_lines.product_name
        LEFT JOIN product_images ON products.name = product_images.product_name
        WHERE order_lines.order_id = ?
        GROUP BY order_lines.id
        ORDER BY product_images.position"
       [order-id])))
  (if (and (. items 1) (not (empty-table? (. items 1))))
    (icollect [_ item (ipairs items)]
      (do
        (when (. item :images)
          (tset item :images (split (. item :images) ",")))
        item))
    []))

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

(fn authenticate-request [db request]
  (let [cookies-header (. request.headers :Cookie)
        cookies (if cookies-header (parse-values cookies-header) {})
        session-id cookies.auth]
    (if (not (empty? session-id))
      (let [sessions
             (_G.must
              (luna.db.query-assoc
                db
                "SELECT id FROM auth_sessions
                 WHERE id = ?
                 AND expires_at > STRFTIME('%Y-%m-%d %H:%M:%S', DATETIME('now'))"
                [session-id]))]
        (< 0 (# sessions)))
      false)))

{: improve-typography
 : starts-with?
 : ends-with?
 : trim
 : trim-left
 : trim-right
 : file-exists?
 : parse-values
 : order-id
 : handle-upload
 : with-tx
 : append
 : equal-tables?
 : empty-table?
 : split
 : concat
 : merge
 : empty?
 : now
 : basket
 : string->number
 : authenticate-request}