liyad-webapp-example/app.lisp at master · shellyln/liyad-webapp-example · GitHub

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

($console-log ($concat "filename: " $__filename))
($console-log ($concat "dirname: "  $__dirname))
($console-log ($concat "profile: "  $__profile))

($require "./index")


;; Run the web server on port 3000.
($let url ($node-require "url"))
($let srv ($require "liyad-lisp-pkg-example" "lisp"))
($let db  ($node-require "./db.js"))


;; Controller functions
($defun output-render-result (e html req res) ($if ($not e)
    ($last
        (::res@writeHead 200 (# (Content-Type "text/html")))
        (::res@end ($concat "<!DOCTYPE html>" html)) )
    ($last
        (::res@writeHead 500 (# (Content-Type "text/plain")))
        (::res@end ($concat "Error: " e)) ) ))

($defun output-render-result-with-trans (e html req res)
    ;; Finalize date
    ($then ($if ($not e) (::db:commit) (::db:rollback))
        ;; Process the rendering result.
        (|-> ()    use (e html req res) (output-render-result e           html req res))
        (|-> (err) use (e html req res) (output-render-result ($or e err) html req res)) ))

($defun build-page (req res page)
    (|-> (data) use (req res page)
        ($render
            ;; LSX notation
            (page data)
            ;; Renderer
            (|-> (e html) use (req res)
                (output-render-result-with-trans e html req res) ))))

($defun view-with-trans (req res pipes page)
    ($then
        ($resolve-pipe nil
            ;; Fetch data (from Model layer)
            (-> (data) (::db:begin))
            ...pipes
            ;; TODO: transaction should or should not complete before rendering???
            ;; Render (View layer)
            (build-page req res page) )
        ;; Errors on fetching data or rendering
        (-> () nil) (|-> (e) use (req res)
            (output-render-result-with-trans e null req res) )))


;; Defining partial page components.
($defun page-header-footer (title-text content-node)
    (html
        (head (title title-text))
        (body (div "this is the header")
              ($=for ($range 1 3)
                  content-node
                  $data)
              (div "this is the footer") )))


;; Register url handlers to web server.
(::srv:#get "/" (-> (req res)
    ($let u (::url:parse ::req:url))
    (::res@writeHead 200 (# (Content-Type "text/html")))
    (::res@end ($concat "hit / ," ::req:method "," ::u:path)) ))


;; It need LSX profile and bootstrap javascript file.
(::srv:#get "/lsx" (-> (req res)
    ($let q-res (#)) ($let q-res-push
        (|-> (name) use (q-res)
            (|-> (data) use (q-res name)
                ($set (q-res ($eval name)) data) ($last data) )))
    ;; Data pipeline definition for rendering the page.
    ($let pipes ($list
        (-> (data) (::db:query "select * from x")) (q-res-push "r1")
        (-> (data) (::db:query "select * from y")) (q-res-push "r2")
        (-> (data) (::db:query "select * from z")) (q-res-push "r3") ))
    ;; Declarative view definition.
    ($let page (|-> (data) use (req res q-res)
        ($let u (::url:parse ::req:url))
        (page-header-footer "Welcome to LSX example"
            (div (h1 (Hello (@ (name ::u:path))))
                (p ($datetime-to-iso-string ($now)))
                """p@{(style (color "red"))}
                Good morning.
                %%%(h4 "last query result: " data)
                %%%(h4 "all results: " ($json-stringify q-res))
                """ )) ))
    ;; Process data and render the view.
    (view-with-trans req res pipes page) ))


;; Start server.
(::srv:serve 3000) ($last "start server")