This commit is contained in:
Akira Tempaku 2024-04-12 03:49:34 +09:00
parent 0441d03206
commit 21c2d8aa99
18 changed files with 130 additions and 117 deletions

4
hp.asd
View file

@ -4,5 +4,7 @@
:defsystem-depends-on ("wild-package-inferred-system") :defsystem-depends-on ("wild-package-inferred-system")
:class "winfer:wild-package-inferred-system" :class "winfer:wild-package-inferred-system"
:pathname "src" :pathname "src"
:depends-on ("hp/main") :depends-on ("hp/app")
:in-order-to ((test-op (test-op "hp-tests")))) :in-order-to ((test-op (test-op "hp-tests"))))
(register-system-packages "lack-middleware-accesslog" '(:lack.middleware.accesslog))

View file

@ -1,6 +1,5 @@
@charset "utf-8"; @charset "utf-8";
body { body {
height: 100svh; display: block;
width: 100%;
} }

3
qlfile
View file

@ -1,8 +1,5 @@
ql wild-package-inferred-system ql wild-package-inferred-system
ql fiveam ql fiveam
ql alexandria
ql lack
ql clack
ql cl-jingle ql cl-jingle
git piccolo https://github.com/skyizwhite/piccolo.git git piccolo https://github.com/skyizwhite/piccolo.git
git ningle-fbr https://github.com/skyizwhite/ningle-fbr.git git ningle-fbr https://github.com/skyizwhite/ningle-fbr.git

View file

@ -10,18 +10,6 @@
(:class qlot/source/ql:source-ql (:class qlot/source/ql:source-ql
:initargs (:%version :latest) :initargs (:%version :latest)
:version "ql-2023-10-21")) :version "ql-2023-10-21"))
("alexandria" .
(:class qlot/source/ql:source-ql
:initargs (:%version :latest)
:version "ql-2023-10-21"))
("lack" .
(:class qlot/source/ql:source-ql
:initargs (:%version :latest)
:version "ql-2023-10-21"))
("clack" .
(:class qlot/source/ql:source-ql
:initargs (:%version :latest)
:version "ql-2023-10-21"))
("cl-jingle" . ("cl-jingle" .
(:class qlot/source/ql:source-ql (:class qlot/source/ql:source-ql
:initargs (:%version :latest) :initargs (:%version :latest)
@ -29,8 +17,8 @@
("piccolo" . ("piccolo" .
(:class qlot/source/git:source-git (:class qlot/source/git:source-git
:initargs (:remote-url "https://github.com/skyizwhite/piccolo.git") :initargs (:remote-url "https://github.com/skyizwhite/piccolo.git")
:version "git-2ae90c290e86a81f608ce0bced119896cc12b6bf")) :version "git-4fd887fc1bff812f10e57aca8011166f0b6a8c6d"))
("ningle-fbr" . ("ningle-fbr" .
(:class qlot/source/git:source-git (:class qlot/source/git:source-git
:initargs (:remote-url "https://github.com/skyizwhite/ningle-fbr.git") :initargs (:remote-url "https://github.com/skyizwhite/ningle-fbr.git")
:version "git-68c3e0494da254fb39e6b5d0f4b54343f72dd13c")) :version "git-438030b0b89dc706c37932616e6bf82d0416ea26"))

View file

@ -1,42 +1,38 @@
(uiop:define-package #:hp/app (defpackage #:hp
(:nicknames #:hp/app)
(:use #:cl) (:use #:cl)
(:local-nicknames (#:jg #:jingle)) (:local-nicknames (#:jg #:jingle))
(:local-nicknames (#:fbr #:ningle-fbr)) (:local-nicknames (#:fbr #:ningle-fbr))
(:local-nicknames (#:pi #:piccolo)) (:local-nicknames (#:pi #:piccolo))
(:local-nicknames (#:cmp #:hp/components/*)) (:local-nicknames (#:view #:hp/view))
(:import-from #:lack) (:local-nicknames (#:cmp #:hp/components/**/*))
(:export #:*app* (:import-from #:lack.middleware.accesslog
#:update-routes)) #:*lack-middleware-accesslog*)
(in-package #:hp/app) (:export #:start
#:stop
#:update))
(in-package #:hp)
(defparameter *raw-app* (jg:make-app)) (defparameter *app* (jg:make-app :address "localhost"
:port 3000))
(defmethod jg:not-found ((app jg:app)) (defmethod jg:not-found ((app jg:app))
(jg:with-html-response (view:render-page (cmp:not-found-page)
(jg:set-response-status 404) :status :not-found
(pi:element-string (cmp:not-found-page)))) :title "404 Not Found"
:description "お探しのページは見つかりませんでした。"))
(defun update-routes () (defun update ()
(fbr:enable-file-based-routing *raw-app* (jg:clear-middlewares *app*)
:system "hp" (jg:install-middleware *app* *lack-middleware-accesslog*)
:directory "src/routes")) (jg:static-path *app* "/public/" "public/")
(fbr:assign-routes *app*
:system "hp"
:directory "src/routes"))
(update)
(update-routes) (defun start ()
(jg:start *app*))
(defun exist-public-file-p (path) (defun stop ()
(let ((pathname (probe-file (concatenate 'string "public" path)))) (jg:stop *app*))
(and pathname
(pathname-name pathname))))
(defparameter *app*
(lack:builder :accesslog
(:static
:path (lambda (path)
(if (exist-public-file-p path)
path
nil))
:root (asdf:system-relative-pathname :hp "public/"))
*raw-app*))
; for clackup cmd
*app*

View file

@ -0,0 +1,12 @@
(defpackage #:hp/components/global/document
(:use #:cl)
(:local-nicknames (#:pi #:piccolo))
(:export #:document))
(in-package #:hp/components/global/document)
(pi:define-element document (metadata)
(pi:h
(html :lang "ja"
metadata
(body :hx-ext "head-support"
pi:children))))

View file

@ -0,0 +1,9 @@
(defpackage #:hp/components/global/layout
(:use #:cl)
(:local-nicknames (#:pi #:piccolo))
(:export #:layout))
(in-package #:hp/components/global/layout)
(pi:define-element layout ()
(pi:h
(main pi:children)))

View file

@ -0,0 +1,18 @@
(defpackage #:hp/components/global/metadata
(:use #:cl)
(:local-nicknames (#:pi #:piccolo))
(:export #:metadata))
(in-package #:hp/components/global/metadata)
(pi:define-element metadata (title description)
(pi:h
(head
(meta :charset "UTF-8")
(title (format nil "~@[~a | ~]skyizwhite.dev" title))
(meta
:name "description"
:content (or description "pakuの個人サイト"))
(script :src "/public/js/htmx.js")
(script :src "/public/js/htmx-ext/head-support.js")
(script :src "/public/js/alpine.js" :defer t)
(link :rel "stylesheet" :type "text/css" :href "/public/style/main.css"))))

View file

@ -0,0 +1,10 @@
(defpackage #:hp/components/global/not-found
(:use #:cl)
(:local-nicknames (#:pi #:piccolo))
(:export #:not-found-page))
(in-package #:hp/components/global/not-found)
(pi:define-element not-found-page ()
(pi:h
(section
(h1 "404 Not Found"))))

View file

@ -1,18 +0,0 @@
(uiop:define-package #:hp/components/layout
(:use #:cl)
(:local-nicknames (#:pi #:piccolo))
(:export #:layout))
(in-package #:hp/components/layout)
(pi:define-element layout ()
(pi:h
(html
(head
(title "skyizwhite.dev")
(script :src "/js/htmx.min.js")
(script :src "/js/htmx-ext/head-support.js")
(script :src "/js/alpine.min.js" :defer t)
(link :rel "stylesheet" :href "/style/main.css" type="text/css"))
(body :hx-ext "head-support"
(main
pi:children)))))

View file

@ -1,13 +0,0 @@
(uiop:define-package #:hp/components/not-found
(:use #:cl)
(:local-nicknames (#:pi #:piccolo))
(:import-from #:hp/components/layout
#:layout)
(:export #:not-found-page))
(in-package #:hp/components/not-found)
(pi:define-element not-found-page ()
(pi:h
(layout
(section
(h1 "404 Not Found")))))

View file

@ -1,27 +0,0 @@
(uiop:define-package :hp
(:nicknames #:hp/main)
(:use #:cl)
(:import-from #:clack)
(:import-from #:hp/app
#:*app*
#:update-routes)
(:export #:start-server
#:stop-server
#:update-routes))
(in-package :hp)
(defparameter *server* nil)
(defun start-server ()
(if *server*
(format t "Server is already running.~%")
(setf *server* (clack:clackup *app*
:address "localhost"
:port 3000))))
(defun stop-server ()
(if *server*
(prog1
(clack:stop *server*)
(setf *server* nil))
(format t "No servers running.~%")))

21
src/routes/about.lisp Normal file
View file

@ -0,0 +1,21 @@
(defpackage #:hp/routes/about
(:use #:cl)
(:local-nicknames (#:pi #:piccolo))
(:local-nicknames (#:view #:hp/view))
(:export #:on-get))
(in-package #:hp/routes/about)
;;; View
(pi:define-element page ()
(pi:h
(section
(h1 "About"))))
;;; Controller
(defun on-get (params)
(declare (ignore params))
(view:render-page (page)
:title "about"
:description "pakuの自己紹介"))

View file

@ -1,8 +1,7 @@
(uiop:define-package #:hp/routes/index (defpackage #:hp/routes/index
(:use #:cl) (:use #:cl)
(:local-nicknames (#:pi #:piccolo)) (:local-nicknames (#:pi #:piccolo))
(:local-nicknames (#:jg #:jingle)) (:local-nicknames (#:view #:hp/view))
(:local-nicknames (#:cmp #:hp/components/*))
(:export #:on-get)) (:export #:on-get))
(in-package #:hp/routes/index) (in-package #:hp/routes/index)
@ -10,11 +9,13 @@
(pi:define-element page () (pi:define-element page ()
(pi:h (pi:h
(div))) (section
(h1 "Hello, World!")
(a :href "/about" :hx-boost "true"
"About"))))
;;; Controller ;;; Controller
(defun on-get (params) (defun on-get (params)
(declare (ignore params)) (declare (ignore params))
(jg:with-html-response (view:render-page (page)))
(pi:element-string (page))))

18
src/view.lisp Normal file
View file

@ -0,0 +1,18 @@
(defpackage #:hp/view
(:use #:cl)
(:local-nicknames (#:jg #:jingle))
(:local-nicknames (#:pi #:piccolo))
(:local-nicknames (#:cmp #:hp/components/**/*))
(:export #:render-page))
(in-package #:hp/view)
(defun render-page (page &key status title description)
(jg:with-html-response
(and status (jg:set-response-status status))
(pi:elem-str
(let ((md (cmp:metadata :title title :description description))
(body (cmp:layout page)))
(if (jg:get-request-header "HX-Boosted")
(pi:h (<> md body))
(pi:h (cmp:document :metadata md
body)))))))

View file

@ -1,4 +1,4 @@
(uiop:define-package #:hp-tests/example (defpackage #:hp-tests/example
(:use #:cl (:use #:cl
#:fiveam)) #:fiveam))
(in-package #:hp-tests/example) (in-package #:hp-tests/example)