implement shop

1 files changed, 222 insertions, 0 deletions

diff --git a/lib.fnl b/lib.fnl
new file mode 100644
index 0000000..cb437a2
--- /dev/null
+++ b/lib.fnl
@@ -0,0 +1,222 @@
+(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}