(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}