4358148e |
1 | (in-package :lol-test) |
2 | |
d1a7fc5a |
3 | (defclass lol-test-server (ucw-core:standard-server) |
4358148e |
4 | ()) |
5 | |
d1a7fc5a |
6 | (defclass lol-test-application (ucw:standard-application) |
4358148e |
7 | () |
8 | (:default-initargs |
9 | :url-prefix "/lisp-on-lines.test/" |
10 | ; :www-roots (list (cons "static/" (project-relative-pathname #P"wwwroot/"))) |
11 | )) |
12 | |
13 | (defparameter *lol-test-ucw-application* (make-instance 'lol-test-application)) |
14 | |
15 | (defun make-backend () |
16 | (ucw::make-backend |
17 | :httpd |
18 | :host "localhost" |
19 | :port 9090)) |
20 | |
21 | (defun make-server () |
22 | (make-instance |
23 | 'lol-test-server |
24 | :backend (make-backend))) |
25 | |
26 | (defparameter *lol-test-ucw-server* (make-server)) |
27 | |
d1a7fc5a |
28 | (ucw-core:register-application *lol-test-ucw-server* *lol-test-ucw-application*) |
4358148e |
29 | |
d1a7fc5a |
30 | (ucw-core:defentry-point "index.ucw" (:application *lol-test-ucw-application*) () |
4358148e |
31 | (call 'lol-test-window)) |
32 | |
33 | (defun startup-lol-ucw-test () |
d1a7fc5a |
34 | (ucw-core:startup-server *lol-test-ucw-server*)) |
4358148e |
35 | |
36 | (defun shutdown-lol-ucw-test () |
d1a7fc5a |
37 | (ucw-core:shutdown-server *lol-test-ucw-server*)) |
4358148e |
38 | |
d1a7fc5a |
39 | (ucw-core:defcomponent lol-test-window (standard-window-component) |
4358148e |
40 | () |
41 | (:default-initargs |
42 | :body (make-instance 'lol-test-suite-component))) |
43 | |
d1a7fc5a |
44 | (define-symbol-macro $window (ucw-core:context.window-component *context*)) |
4358148e |
45 | |
46 | (define-symbol-macro $body (window-body $window)) |
47 | |
d1a7fc5a |
48 | (ucw-core:defcomponent lol-test-suite-component () |
4358148e |
49 | ((test :component lol-test-simple-action :accessor test) |
50 | (component :component lol-test-render :accessor component))) |
51 | |
52 | (define-symbol-macro $test (test $body)) |
53 | |
54 | (define-symbol-macro $component (component $body)) |
55 | |
d1a7fc5a |
56 | (defmethod ucw-core:render ((self lol-test-suite-component)) |
4358148e |
57 | (<:H1 "Lisp On Lines Web test suite") |
58 | (render (slot-value self 'test)) |
59 | (<:div |
60 | :style "border:1px solid black;" |
61 | (render (slot-value self 'component)))) |
62 | |
d1a7fc5a |
63 | (ucw-core:defcomponent lol-test-render () |
4358148e |
64 | ((message :initform "test" :accessor message :initarg :message))) |
65 | |
d1a7fc5a |
66 | (defmethod ucw-core:render ((self lol-test-render)) |
4358148e |
67 | (<:h3 :id "test-render" |
68 | (<:as-html (format nil "Hello ~A." (message self))))) |
69 | |
d1a7fc5a |
70 | (ucw-core:defcomponent lol-test-simple-action () |
4358148e |
71 | ()) |
72 | |
d1a7fc5a |
73 | (defmethod ucw-core:render ((self lol-test-simple-action)) |
4358148e |
74 | (<:ul |
d1a7fc5a |
75 | (<:li (<ucw:a |
4358148e |
76 | :function |
77 | (lambda () |
78 | (setf (message $component) |
79 | (format nil "~A : ~A" (message $component) "FUNCTION"))) |
80 | "Test <:A :FUNCTION type actions")) |
81 | (<:li |
d1a7fc5a |
82 | (<ucw:a |
4358148e |
83 | :action (setf (message $component) |
84 | (format nil "~A : ~A" (message $component) "ACTION")) |
85 | "Test <:A :ACTION type actions")) |
86 | (<:li |
d1a7fc5a |
87 | (<ucw:a |
4358148e |
88 | :action* (make-action |
89 | (lambda () |
90 | (setf (message $component) |
91 | (format nil "~A : ~A" (message $component) "ACTION*")))) |
92 | "Test <:A :ACTION* type actions")) |
93 | (<:li |
d1a7fc5a |
94 | (<ucw:a |
4358148e |
95 | :action (call-component $component (make-instance 'lol-test-answer)) |
b7657b86 |
96 | "Test CALL-COMPONENT/ANSWER-COMPONENT")) |
97 | (<:li |
d1a7fc5a |
98 | (<ucw:a |
b7657b86 |
99 | :action (call-component $component (make-instance 'lol-test-call-magic)) |
100 | "Test CALL/ANSWER MAGIC")) |
101 | (<:li |
d1a7fc5a |
102 | (<ucw:a |
b7657b86 |
103 | :action (call-component $component (make-instance 'lol-test-call-answer-action-magic)) |
104 | "Test CALL/ANSWER ACTION MAGIC")) |
4358148e |
105 | (<:li |
d1a7fc5a |
106 | (<ucw:a |
4358148e |
107 | :action (call-component $component (make-instance 'lol-test-simple-form)) |
108 | "Test Simple Form")) |
109 | (<:li |
d1a7fc5a |
110 | (<ucw:a |
4358148e |
111 | :action (call-component $component (make-instance 'lol-test-multi-submit-form)) |
112 | "Test Multi Form")) |
113 | (<:li |
d1a7fc5a |
114 | (<ucw:a |
4358148e |
115 | :action (call-component $component (make-instance 'lol-test-input)) |
b7657b86 |
116 | "Test Form input")) |
117 | )) |
4358148e |
118 | |
d1a7fc5a |
119 | (ucw-core:defcomponent lol-test-answer (lol-test-render) () |
4358148e |
120 | (:default-initargs :message "CALL was ok. Go Back will answer")) |
121 | |
d1a7fc5a |
122 | (defmethod ucw-core:render :wrapping ((self lol-test-answer)) |
4358148e |
123 | (call-next-method) |
d1a7fc5a |
124 | (<ucw:a :action (answer-component self nil) "Go Back.")) |
4358148e |
125 | |
d1a7fc5a |
126 | (ucw-core:defcomponent lol-test-simple-form (lol-test-render) () |
4358148e |
127 | (:default-initargs :message "Testing Simple Form:")) |
128 | |
d1a7fc5a |
129 | (defmethod ucw-core:render :wrapping ((self lol-test-simple-form)) |
4358148e |
130 | (call-next-method) |
d1a7fc5a |
131 | (<ucw:form |
4358148e |
132 | :action (setf (message self) "Form Submitted") |
133 | (<:submit)) |
d1a7fc5a |
134 | (<ucw:a :action (answer-component self nil) "Go Back.")) |
4358148e |
135 | |
d1a7fc5a |
136 | (ucw-core:defcomponent lol-test-multi-submit-form (lol-test-render) () |
4358148e |
137 | (:default-initargs :message "Testing Simple Form:")) |
138 | |
d1a7fc5a |
139 | (defmethod ucw-core:render :wrapping ((self lol-test-multi-submit-form)) |
4358148e |
140 | (call-next-method) |
d1a7fc5a |
141 | (<ucw:form |
4358148e |
142 | :action (setf (message self) "Form Submitted") |
143 | (<:submit) |
d1a7fc5a |
144 | (<ucw:submit :action (setf (message self) "Submit 2" ) |
4358148e |
145 | :value "2") |
d1a7fc5a |
146 | (<ucw:submit :action (setf (message self) "Submit 3") |
4358148e |
147 | 3)) |
d1a7fc5a |
148 | (<ucw:a :action (answer-component self nil) "Go Back.")) |
4358148e |
149 | |
d1a7fc5a |
150 | (ucw-core:defcomponent lol-test-input (lol-test-render) |
4358148e |
151 | () |
152 | (:default-initargs :message "Testing INPUTS")) |
153 | |
d1a7fc5a |
154 | (defmethod ucw-core:render :wrapping ((self lol-test-input)) |
4358148e |
155 | (call-next-method) |
d1a7fc5a |
156 | (<ucw:form |
4358148e |
157 | :function (constantly t) |
d1a7fc5a |
158 | (<ucw:input :type "text" :accessor (message self)) |
4358148e |
159 | |
160 | (<:submit) |
161 | ) |
d1a7fc5a |
162 | (<ucw:a :action (answer-component self nil) "Go Back.")) |
4358148e |
163 | |
164 | |
165 | |
d1a7fc5a |
166 | (ucw-core:defcomponent lol-test-call-magic (lol-test-render) |
b7657b86 |
167 | () |
168 | (:default-initargs :message "Testing CALL magic.")) |
169 | |
d1a7fc5a |
170 | (defmethod ucw-core:render :wrapping ((self lol-test-call-magic)) |
b7657b86 |
171 | (call-next-method) |
d1a7fc5a |
172 | (<ucw:a :action (setf (message self) (call 'lol-test-answer-magic)) "Test CALL") |
b7657b86 |
173 | (<:br) |
d1a7fc5a |
174 | (<ucw:a :action (answer-component self nil) "Go Back.")) |
b7657b86 |
175 | |
176 | |
177 | |
d1a7fc5a |
178 | (ucw-core:defcomponent lol-test-answer-magic (lol-test-render) |
b7657b86 |
179 | () |
180 | (:default-initargs :message "Hit it to answer")) |
181 | |
d1a7fc5a |
182 | (defmethod ucw-core:render :wrapping ((self lol-test-answer-magic)) |
b7657b86 |
183 | (call-next-method) |
184 | |
d1a7fc5a |
185 | (<ucw:a :action (answer "Ja, dat is vut ve answer" ) "IT! (hit here)")) |
b7657b86 |
186 | |
d1a7fc5a |
187 | (ucw-core:defcomponent lol-test-call-answer-action-magic (lol-test-render) |
b7657b86 |
188 | () |
189 | (:default-initargs :message "Hit it to answer")) |
190 | |
d1a7fc5a |
191 | (ucw:defaction test-call-component () |
b7657b86 |
192 | (call 'lol-test-call-answer-action-magic :message "We made it")) |
193 | |
d1a7fc5a |
194 | (ucw:defaction test-answer-component () |
b7657b86 |
195 | (answer "We Made IT BACK!!!")) |
196 | |
d1a7fc5a |
197 | (defmethod ucw-core:render :wrapping ((self lol-test-call-answer-action-magic)) |
b7657b86 |
198 | (call-next-method) |
d1a7fc5a |
199 | (<ucw:a :action (test-call-component) "Test CALL from ACTION") |
b7657b86 |
200 | (<:br) |
d1a7fc5a |
201 | (<ucw:a :action (test-answer-component) "Test ANSWER from ACTION")) |
b7657b86 |
202 | |
4358148e |
203 | |
204 | |
205 | |
206 | |
207 | |