1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
(local lib (require :lib))
(fn create-order [db]
(let [id (_G.must (luna.crypto.random-string 16))]
(_G.must
(luna.db.exec
db "INSERT INTO orders (id, creation_time) VALUES (?, ?)"
[id (lib.now)]))
id))
;; FIXME: prone to race conditions
(fn place-order [db id name contact consent]
(local current-state
(_G.must
(luna.db.query db "SELECT state FROM orders WHERE id = ?" [id])))
(when (~= "cart" (. current-state 1 1))
(error "order must be a cart in order to place it"))
(lib.with-tx db
(fn [tx]
;; remove ordered products from stock
(_G.must
(luna.db.exec-tx tx
"UPDATE products
SET stock = stock - (SELECT quantity
FROM order_lines
WHERE product_name = products.name
AND order_id = ?)
WHERE products.name IN (SELECT product_name
FROM order_lines
WHERE order_id = ?)"
[id id]))
(_G.must
(luna.db.exec-tx tx
"UPDATE orders SET placement_time = ?, state = 'placed', name = ?,
contact = ?, consent = ?
WHERE id = ?"
[(lib.now) name contact consent id])))))
(fn finish-order [db id]
(local current-state
(_G.must
(luna.db.query db "SELECT state FROM orders WHERE id = ?" [id])))
(when (~= "placed" (. current-state 1 1))
(error "order must be placed in order to finish it"))
(_G.must
(luna.db.exec db "UPDATE orders SET state = 'done' WHERE id = ?" [id])))
;; FIXME: prone to race conditions
(fn cancel-order [db id]
(local current-state
(_G.must
(luna.db.query db "SELECT state FROM orders WHERE id = ?" [id])))
(when (~= "placed" (. current-state 1 1))
(error "order must be placed in order to cancel it"))
(lib.with-tx db
(fn [tx]
;; return stock
(_G.must
(luna.db.exec-tx tx
"UPDATE products
SET stock = stock + (SELECT quantity
FROM order_lines
WHERE product_name = products.name
AND order_id = ?)
WHERE products.name IN (SELECT product_name
FROM order_lines
WHERE order_id = ?)"
[id id]))
(_G.must
(luna.db.exec-tx tx
"UPDATE orders SET state = 'canceled' WHERE id = ?"
[id])))))
(fn order-id [request]
(let [cookies-header (. request.headers :Cookie)
cookies (if cookies-header (lib.parse-values cookies-header) {})]
cookies.order))
(fn create-order-line [db order-id name quantity]
(_G.must
(luna.db.exec
db
"INSERT INTO order_lines (order_id, product_name, quantity, creation_time)
VALUES (?, ?, ?, ?)"
[order-id name quantity (lib.now)])))
(fn delete-order-line [db id]
(_G.must
(luna.db.exec db "DELETE FROM order_lines WHERE id = ?" [id])))
(fn basket [db order-id]
(_G.must
(luna.db.query-assoc
db
"SELECT order_lines.id,
products.name,
products.title,
products.price_per AS \"price-per\",
products.packaging,
products.type,
products.short_description AS \"short-description\",
products.image1,
order_lines.quantity
FROM order_lines
INNER JOIN products ON products.name = order_lines.product_name
WHERE order_lines.order_id = ?
GROUP BY order_lines.id
ORDER BY order_lines.creation_time ASC"
[order-id])))
(fn in-basket? [db order-id product-name]
(= 1
(#
(_G.must
(luna.db.query
db
"SELECT id
FROM order_lines
WHERE order_lines.order_id = ?
AND order_lines.product_name = ?
LIMIT 1"
[order-id product-name])))))
{: create-order
: place-order
: finish-order
: cancel-order
: order-id
: create-order-line
: delete-order-line
: basket
: in-basket?}
|
