(local fennel (require :vendor.fennel)) (local lib (require :lib)) (when _G.unpack (tset table :unpack _G.unpack)) (fn _G.must [...] (local (ok? result) ...) (if ok? result (error result))) (fn _G.pp [...] (local args (table.pack ...)) (for [i 1 args.n] (print (fennel.view (. args i))))) (fn _G.reload [module] (local old (require module)) (tset package :loaded module nil) (local (ok? new) (pcall require module)) (if (not ok?) (do (tset package :loaded module old) (error new)) (when (= (type new) :table) (do (each [k v (pairs new)] (tset old k v)) (each [k (pairs old)] (when (not (. new k)) (tset old k nil))) (tset package :loaded module old))))) (local db (_G.must (luna.db.open "file:var/db.sqlite?_journal=WAL&_sync=NORMAL&_txlock=immediate"))) (_G.must (luna.db.exec db "PRAGMA foreign_keys=ON; CREATE TABLE IF NOT EXISTS users( name TEXT PRIMARY KEY, password TEXT NOT NULL ); CREATE TABLE IF NOT EXISTS auth_sessions( id TEXT PRIMARY KEY, creation_time TEXT NOT NULL, user TEXT NOT NULL REFERENCES users(name), expires_at TEXT NOT NULL ); CREATE TABLE IF NOT EXISTS products( name TEXT PRIMARY KEY, creation_time TEXT NOT NULL, position INTEGER NOT NULL DEFAULT 0, published BOOLEAN NOT NULL DEFAULT false, title TEXT NOT NULL, type TEXT NOT NULL, packaging TEXT NOT NULL, description TEXT, short_description TEXT NOT NULL, year INTEGER, season TEXT, region TEXT, recommendations TEXT, price_per REAL, stock REAL, vendor TEXT, vendor_article TEXT, vendor_description TEXT, vendor_price_per REAL, vendor_product_link TEXT, image1 TEXT REFERENCES files(name), image2 TEXT REFERENCES files(name), image3 TEXT REFERENCES files(name), image4 TEXT REFERENCES files(name), image5 TEXT REFERENCES files(name) ); CREATE TABLE IF NOT EXISTS files( name TEXT PRIMARY KEY, creation_time TEXT NOT NULL, type TEXT NOT NULL, size REAL NOT NULL, thumbnail TEXT, description TEXT ); CREATE TABLE IF NOT EXISTS orders( id TEXT PRIMARY KEY, creation_time TEXT NOT NULL, placement_time TEXT, first_name TEXT, contact TEXT ); CREATE TABLE IF NOT EXISTS order_lines( id INTEGER PRIMARY KEY, creation_time TEXT NOT NULL, order_id INTEGER NOT NULL REFERENCES orders(id), product_name TEXT NOT NULL REFERENCES products(name), quantity REAL NOT NULL );" [])) (fn scan-routes [dir] (var result {}) (each [_ f (ipairs (_G.must (luna.fs.files dir)))] (if f.dir (tset result f.name (scan-routes (.. dir "/" f.name))) (let [trimmed-name (lib.trim-right f.name ".fnl")] (tset result trimmed-name (require (.. dir "." trimmed-name)))))) result) (fn match-route [routes path] (local variables {}) (fn _match [routes parts] (var pointer routes) (while (and (< 0 (# parts)) (= (type pointer) "table")) (local part (table.remove parts 1)) (set pointer (if (. pointer part) (. pointer part) ;; test for routes starting with _ (do (var res nil) (each [key value (pairs pointer) &until res] (if (lib.starts-with? key "_") (do (set res (_match value parts)) (when res (tset variables key part))) nil)) res)))) (when (and (= (type pointer) "table") pointer.index) (set pointer (. pointer :index))) (values pointer variables)) (if (or (= path "") (= path "/")) (values (. routes "index") variables) (_match routes (lib.split (lib.trim path "/") "/")))) (fn test-match-route [] (let [routes {:index "index" :shop {:index "shop/index" :cart "shop/cart" :_product {:index "shop/_product/index" :edit "shop/_product/edit"}} :faq "faq" :_page {:edit "_page/edit"}}] (fn test [path exp-res exp-vars] (local (res vars) (match-route routes path)) (assert (= exp-res res) (.. "router test failed for " path ": expected " exp-res ", got " res)) (assert (lib.equal-tables? exp-vars vars) (.. "router test failed for " path ": expected " (fennel.view exp-vars) ", got " (fennel.view vars)))) (test "" "index" {}) (test "/" "index" {}) (test "shop" "shop/index" {}) (test "shop/" "shop/index" {}) (test "shop/index" "shop/index" {}) (test "faq" "faq" {}) (test "faq/" "faq" {}) (test "shop/cart" "shop/cart" {}) (test "shop/cart/" "shop/cart" {}) (test "foobar/edit" "_page/edit" {:_page "foobar"}) (test "foobar/edit/" "_page/edit" {:_page "foobar"}) (test "shop/xyz" "shop/_product/index" {:_product "xyz"}) (test "shop/xyz/index" "shop/_product/index" {:_product "xyz"}) (test "shop/xyz/edit" "shop/_product/edit" {:_product "xyz"}))) (test-match-route) (local routes (scan-routes "pages")) (fn router [request] (if (and (lib.ends-with? request.path "/") (~= request.path "/")) (values 302 {:Location (lib.trim-right request.path "/")} "") (let [(handler params) (match-route routes request.path)] (tset request :params params) (if (and (= (type handler) "table") handler.render) (let [(code headers content) (handler.render request db (lib.authenticate-request db request))] (values code headers (.. "\n" content))) (values 404 {:content-type "text/html"} "not found"))))) (luna.router.route "/" router) (luna.router.static "GET /static/" "static/") (when (= 0 (# (_G.must (luna.db.query db "SELECT name FROM users LIMIT 1" [])))) (let [password (_G.must (luna.crypto.random-string 20)) hash (_G.must (luna.crypto.password-hash password))] (_G.must (luna.db.exec db "INSERT INTO users (name, password) VALUES (?, ?)" ["admin" hash])) (print (.. "admin user created: admin / " password)))) (when luna.debug (luna.on-eval (fn [code] (fennel.eval code {:env _G}))))