Skip to content

Commit b4f1f1a

Browse files
ryukinixryukinix
authored
Merge pull request #33 from ryukinix/refactor-web
refactor(web): replace weblocks with reblocks
2 parents d05ef6b + 901220a commit b4f1f1a

File tree

8 files changed

+137
-124
lines changed

8 files changed

+137
-124
lines changed

‎.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,3 @@
11
*.fasl
22
system-index.txt
3+
lisp-inference

‎Dockerfile‎

Lines changed: 8 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -2,9 +2,14 @@ FROM commonlispbr/roswell
22
WORKDIR /app
33
RUN ros install commonlispbr/quicksys
44
RUN ros run -s quicksys -e "(qs:install-dist :ultralisp)" -q
5-
RUN ros run -s weblocks -s weblocks-ui -q
6-
COPY . .
5+
RUN ros run -s 40ants-routes -s reblocks -s reblocks-ui -q
6+
COPY roswell roswell
7+
COPY web web
8+
COPY t t
9+
COPY src src
10+
COPY lisp-inference.asd .
11+
COPY *.lisp .
712
RUN ros install ./lisp-inference.asd
813
RUN ros run -s lisp-inference/web -q
914
EXPOSE 40000
10-
ENTRYPOINT "/root/.roswell/bin/inference-server"
15+
ENTRYPOINT ["/root/.roswell/bin/inference-server"]

‎Makefile‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,10 @@ server:
2121
docker-build:
2222
docker build -t $(DOCKER_IMG) .
2323

24+
docker-shell: docker-build
25+
docker run --rm -it --entrypoint=/bin/bash $(DOCKER_IMG)
26+
27+
2428
docker-run: docker-build
2529
docker run --rm -it --network=host $(DOCKER_IMG)
2630

‎lisp-inference.asd‎

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -29,8 +29,9 @@
2929
:version "0.2.0"
3030
:serial t
3131
:depends-on (:lisp-inference
32-
:weblocks
33-
:weblocks-ui
32+
:40ants-routes ;; implicit dependency of reblocks
33+
:reblocks
34+
:reblocks-ui
3435
:clack-handler-hunchentoot
3536
:find-port
3637
:str)
@@ -44,7 +45,5 @@
4445
:version "0.2.0"
4546
:serial t
4647
:pathname "t"
47-
:depends-on (:lisp-inference :prove)
48-
:components ((:file "test"))
49-
:perform (asdf:test-op :after (op c)
50-
(funcall (intern #.(string :run) :prove) c)))
48+
:depends-on (:lisp-inference :rove)
49+
:components ((:file "test")))

‎roswell/inference-server.ros‎

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -4,18 +4,20 @@
44
exec ros -Q -- $0 "$@"
55
|#
66

7-
#+quicklisp (defun ensure-dist-installed (dist nick)
8-
(let ((d (ql-dist:find-dist nick)))
9-
(when (not (and d (ql-dist:installedp d)))
10-
(ql-dist:install-dist dist
11-
:prompt nil))))
7+
#+quicklisp
8+
(defun ensure-dist-installed-and-updated (dist nick)
9+
(let ((d (ql-dist:find-dist nick)))
10+
(if (not (and d (ql-dist:installedp d)))
11+
(ql-dist:install-dist dist
12+
:prompt nil))
13+
(ql:update-dist nick :prompt nil)))
1214

1315
(progn ;;init forms
1416
(ros:ensure-asdf)
15-
#+quicklisp (progn
16-
(ensure-dist-installed "http://dist.ultralisp.org" "ultralisp")
17-
(ql:quickload '(lisp-inference/web)))
18-
17+
#+quicklisp
18+
(progn
19+
(ensure-dist-installed-and-updated "http://dist.ultralisp.org" "ultralisp")
20+
(ql:quickload '(lisp-inference/web)))
1921
)
2022

2123
(defpackage :ros.script.lisp-inference/web

‎run-test.lisp‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
(load "fix-quicklisp")
2-
(ql:quickload '(:prove :lisp-inference/test) :silent t)
3-
(setf prove:*enable-colors* t)
4-
(if (prove:run "t/test.lisp")
2+
(ql:quickload :lisp-inference/test :silent t)
3+
(setf rove:*enable-colors* t)
4+
(if (rove:run* "lisp-inference/test")
55
(sb-ext:exit :code 0)
66
(sb-ext:exit :code 1))

‎t/test.lisp‎

Lines changed: 85 additions & 88 deletions
Original file line numberDiff line numberDiff line change
@@ -1,118 +1,115 @@
11
(defpackage #:lisp-inference/test
22
(:use #:cl
33
#:lisp-inference
4-
#:prove))
5-
4+
#:rove))
65

76
(in-package :lisp-inference/test)
87

98

10-
(plan nil)
11-
12-
13-
(diag "== Inference rules!")
14-
15-
(is (modus-ponens '(^ (=> p q) p))
16-
'q
17-
"Inference: MODUS-PONENS")
18-
19-
(is (modus-tollens '(^ (=> p q) (~ p)))
20-
'(~ q)
21-
"Inference: MODUS-TOLLENS")
22-
23-
(is (syllogism-disjunctive '(^ (v p q) (~ p)))
24-
'q
25-
"Inference: SYLLOGISM-DISJUNCTIVE")
26-
27-
(is (syllogism-hypothetical '(^ (=> x y) (=> y z)))
28-
'(=> X Z)
29-
"Inference: SYLLOGISM-HYPOTHETICAL")
9+
(deftest inference-rules-test
10+
(testing "== Inference rules!"
11+
(ok (equal (modus-ponens '(^ (=> p q) p))
12+
'q)
13+
"Inference: MODUS-PONENS")
3014

31-
(is (addiction 'p 'q)
32-
'(v p q)
33-
"Inference: ADDICTION")
15+
(ok (equal (modus-tollens '(^ (=> p q) (~ p)))
16+
'(~ q))
17+
"Inference: MODUS-TOLLENS")
3418

35-
(is (conjunction '(=> p q) 'p)
36-
'(^ (=> P Q) P)
37-
"Inference: CONJUNCTION")
19+
(ok (equal (syllogism-disjunctive '(^ (v p q) (~ p)))
20+
'q)
21+
"Inference: SYLLOGISM-DISJUNCTIVE")
3822

39-
(is (absorption '(=> r (^ x y)))
40-
'(=> R (^ R (^ X Y)))
41-
"Inference: ABSORPTION")
42-
(is (simplification-first '(^ p q))
43-
'p
44-
"Inference: SIMPLIFICATION FIRST")
45-
(is (simplification-second '(^ r s))
46-
's
47-
"Inference: SIMPLIFICATION SECOND")
23+
(ok (equal (syllogism-hypothetical '(^ (=> x y) (=> y z)))
24+
'(=> X Z))
25+
"Inference: SYLLOGISM-HYPOTHETICAL")
4826

27+
(ok (equal (addiction 'p 'q)
28+
'(v p q))
29+
"Inference: ADDICTION")
4930

50-
(diag "== Equivalence rules!")
31+
(ok (equal (conjunction '(=> p q) 'p)
32+
'(^ (=> P Q) P))
33+
"Inference: CONJUNCTION")
5134

52-
(is (de-morgan '(^ p q))
53-
'(~ (v (~ p) (~ q)))
54-
"Equivalence: DE-MORGAN 1")
55-
(is (de-morgan '(~ (v p q)))
56-
'(^ (~ p) (~ q))
57-
"Equivalence: DE-MORGAN 2")
58-
(is (de-morgan '(~ (^ (~ p) (~ q))))
59-
'(v p q)
60-
"Equivalence: DE-MORGAN 3")
35+
(ok (equal (absorption '(=> r (^ x y)))
36+
'(=> R (^ R (^ X Y))))
37+
"Inference: ABSORPTION")
6138

62-
(is (double-negation '(~ (~ p)))
63-
'p
64-
"Equivalence: DOUBLE-NEGATION 1")
39+
(ok (equal (simplification-first '(^ p q))
40+
'p)
41+
"Inference: SIMPLIFICATION FIRST")
6542

66-
(is (double-negation 'p)
67-
'p
68-
"Equivalence: DOUBLE-NEGATION 2")
43+
(ok (equal (simplification-second '(^ r s))
44+
's)
45+
"Inference: SIMPLIFICATION SECOND")))
6946

7047

71-
(diag "== Truth-table tests!")
48+
(deftest equivalence-rules-test
49+
(testing "== Equivalence rules!"
50+
(ok (equal (de-morgan '(^ p q))
51+
'(~ (v (~ p) (~ q))))
52+
"Equivalence: DE-MORGAN 1")
53+
(ok (equal (de-morgan '(~ (v p q)))
54+
'(^ (~ p) (~ q)))
55+
"Equivalence: DE-MORGAN 2")
7256

73-
(is (eval-expression '(^ p q))
74-
"TFFF"
75-
"AND OPERATION: p ^ q")
57+
(ok (equal (de-morgan '(~ (^ (~ p) (~ q))))
58+
'(v p q))
59+
"Equivalence: DE-MORGAN 3")
7660

77-
(is (eval-expression '(v p q))
78-
"TTTF"
79-
"OR OPERATION: p v q")
61+
(ok (equal (double-negation '(~ (~ p)))
62+
'p)
63+
"Equivalence: DOUBLE-NEGATION 1")
8064

81-
(is (eval-expression '(=> p q))
82-
"TFTT"
83-
"CONDITIONAL OPERATION: p => q")
65+
(ok (equal (double-negation 'p)
66+
'p)
67+
"Equivalence: DOUBLE-NEGATION 2")))
8468

85-
(is (eval-expression '(<=> p q))
86-
"TFFT"
87-
"BICONDITIONAL OPERATION: p <=> q")
8869

89-
(is (eval-expression '([+] p q))
90-
"FTTF"
91-
"XOR OPERATION: p [+] q")
70+
(deftest truth-table-tests
71+
(testing "== Truth-table tests!"
72+
(ok (equal (eval-expression '(^ p q))
73+
"TFFF")
74+
"AND OPERATION: p ^ q")
9275

93-
(is (eval-expression '(~ p))
94-
"FT"
95-
"NOT OPERATION: ~ p")
76+
(ok (equal (eval-expression '(v p q))
77+
"TTTF")
78+
"OR OPERATION: p v q")
9679

97-
(ok (equal-expression '(^ p q)
98-
(de-morgan '(^ p q)))
99-
"EQUAL EXPRESSION 1")
80+
(ok (equal (eval-expression '(=> p q))
81+
"TFTT")
82+
"CONDITIONAL OPERATION: p => q")
10083

101-
(ok (equal-expression '(~ (~ p))
102-
'(p))
103-
"EQUAL EXPRESSION 2")
84+
(ok (equal (eval-expression '(<=> p q))
85+
"TFFT")
86+
"BICONDITIONAL OPERATION: p <=> q")
10487

105-
(diag "== Infix Parsing")
88+
(ok (equal (eval-expression '([+] p q))
89+
"FTTF")
90+
"XOR OPERATION: p [+] q")
10691

107-
(is (infix-to-prefix '(~ (p v q)))
108-
'(~ (v p q)))
92+
(ok (equal (eval-expression '(~ p))
93+
"FT")
94+
"NOT OPERATION: ~ p")
10995

110-
(is (infix-to-prefix '(p => q))
111-
'(=> p q))
96+
(ok (equal-expression '(^ p q)
97+
(de-morgan '(^ p q)))
98+
"EQUAL EXPRESSION 1")
11299

113-
(is (infix-to-prefix '((p v q) <=> ((~ p) ^ (~ q))))
114-
'(<=> (v p q)
115-
(^ (~ p)
116-
(~ q))))
100+
(ok (equal-expression '(~ (~ p))
101+
'p)
102+
"EQUAL EXPRESSION 2")))
117103

118-
(finalize)
104+
(deftest infix-parsing-test
105+
(testing "== Infix Parsing"
106+
(ok (equal (infix-to-prefix '(~ (p v q)))
107+
'(~ (v p q))))
108+
109+
(ok (equal (infix-to-prefix '(p => q))
110+
'(=> p q)))
111+
112+
(ok (equal (infix-to-prefix '((p v q) <=> ((~ p) ^ (~ q))))
113+
'(<=> (v p q)
114+
(^ (~ p)
115+
(~ q)))))))

‎web/webapp.lisp‎

Lines changed: 20 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,26 @@
11
(defpackage lisp-inference/web
22
(:use #:cl
3-
#:weblocks-ui/form
4-
#:weblocks/html)
5-
(:import-from #:weblocks/widget
3+
#:reblocks-ui/form
4+
#:reblocks/html)
5+
(:import-from #:reblocks/widget
66
#:render
77
#:update
88
#:defwidget)
9-
(:import-from #:weblocks/actions
9+
(:import-from #:reblocks/actions
1010
#:make-js-action)
11-
(:import-from #:weblocks/app
11+
(:import-from #:reblocks/app
1212
#:defapp)
13+
(:import-from #:reblocks-ui/core
14+
#:ui-widget)
15+
(:import-from #:reblocks/page
16+
#:init-page)
1317
(:export #:start
1418
#:stop
1519
#:*notes*
1620
#:*proposition*
1721
#:*port*)
1822
(:nicknames #:webapp))
23+
;; reblocks docs: https://40ants.com/reblocks/
1924

2025
(in-package lisp-inference/web)
2126

@@ -30,7 +35,7 @@
3035
:prefix "/"
3136
:description "Lisp Inference Truth Table")
3237

33-
(defwidget table ()
38+
(defwidget table (ui-widget)
3439
((prop
3540
:initarg :prop
3641
:accessor prop)
@@ -57,10 +62,10 @@
5762
(update table))
5863

5964
(defmethod render ((table table))
60-
(with-html
65+
(reblocks/html:with-html ()
6166
(:h1 :align "center" "Lisp Inference Truth Table System")
6267
(:div :align "center"
63-
(with-html-form (:POST (lambda (&key prop &allow-other-keys)
68+
(reblocks-ui/form:with-html-form (:POST (lambda (&key prop &allow-other-keys)
6469
(update-table table prop)))
6570
(:input :type "text"
6671
:name "prop"
@@ -82,17 +87,17 @@
8287
"https://lerax.me/lisp-inference" "lerax.me/lisp-inference"))))
8388

8489
(defun render-note (string)
85-
(with-html
90+
(reblocks/html:with-html ()
8691
(:pre string)))
8792

88-
(defmethod weblocks/session:init ((app truth-table))
89-
(declare (ignorable app))
93+
(defmethod reblocks/page:init-page ((app truth-table) (url-path string) expire-at)
94+
(declare (ignorable app url-path expire-at))
9095
(create-table *proposition*))
9196

9297
(defun start (&optional (port *port*))
93-
(weblocks/debug:on)
94-
(weblocks/server:stop)
95-
(weblocks/server:start :port port))
98+
(reblocks/debug:on)
99+
(reblocks/server:stop)
100+
(reblocks/server:start :port port))
96101

97102
(defun stop ()
98-
(weblocks/server:stop))
103+
(reblocks/server:stop))

0 commit comments

Comments
 (0)