101 lines
4.5 KiB
Common Lisp
101 lines
4.5 KiB
Common Lisp
;;;; SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
;;;; archive.lisp Implementation of blog post archive artifact
|
|
;;;;
|
|
;;;; Copyright (C) 2022 Alejandro "HiPhish" Sanchez
|
|
;;;;
|
|
;;;; This file is part of CL-HSSG.
|
|
;;;;
|
|
;;;; CL-HSSG is free software: you can redistribute it and/or modify it under
|
|
;;;; the terms of the GNU Affero General Public License as published by the
|
|
;;;; Free Software Foundation, either version 3 of the License, or (at your
|
|
;;;; option) any later version.
|
|
;;;;
|
|
;;;; CL-HSSG is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
;;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
|
;;;; FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
|
|
;;;; more details.
|
|
;;;;
|
|
;;;; You should have received a copy of the GNU Affero General Public License
|
|
;;;; along with CL-HSSG If not, see <https://www.gnu.org/licenses/>.
|
|
(defpackage #:hssg-blog/test.artifact.archive
|
|
(:use #:cl)
|
|
(:import-from #:clunit
|
|
#:deftest #:deffixture #:defsuite
|
|
#:assert-true #:assert-false #:assert-equal #:assert-eq))
|
|
(in-package #:hssg-blog/test.artifact.archive)
|
|
|
|
(defsuite hssg-blog.artifact.archive (hssg-blog/test:main))
|
|
(defsuite hssg-blog.artifact.archive.derive (hssg-blog.artifact.archive))
|
|
(defsuite hssg-blog.artifact.archive.to-html (hssg-blog.artifact.archive))
|
|
|
|
|
|
;;; --- DERIVATION ------------------------------------------------------------
|
|
;;; NOTE: we do not test the content of the instruction, we will instead test
|
|
;;; the transformation from artifact to HTML page in a different suite.
|
|
(deffixture hssg-blog.artifact.archive.derive (@body)
|
|
(let ((blog (make-instance 'hssg.blog.artifacts:blog-artifact
|
|
:title "Dummy blog"
|
|
:description "A dummy blog for testing"
|
|
:url '("blog"))))
|
|
@body))
|
|
|
|
(deftest derive-artifact (hssg-blog.artifact.archive.derive)
|
|
(let* ((artifact (make-instance 'hssg.blog.artifacts:archive-page-artifact
|
|
:periods (list) :blog blog))
|
|
(instruction (hssg:derive-artifact artifact)))
|
|
(assert-true (typep instruction 'hssg:write-string-contents))
|
|
;; Probably cannot test contents reasonably here; should move
|
|
;; transformation from archive artifact to HTML artifact to a function
|
|
(with-slots ((path hssg.filesystem::path))
|
|
instruction
|
|
(assert-equal #p"archive/index.html" path))))
|
|
|
|
|
|
;;; --- TRANSFORMATION TO HTML ARTIFACT ---------------------------------------
|
|
(deffixture hssg-blog.artifact.archive.to-html (@body)
|
|
(let ((blog (make-instance 'hssg.blog.artifacts:blog-artifact
|
|
:title "Dummy blog"
|
|
:description "A dummy blog for testing"
|
|
:url '("blog")
|
|
:initial '((:content . (:body (:p "Hello world.") (:p . "Goodbye world.")))))))
|
|
@body))
|
|
|
|
(deftest references-blog (hssg-blog.artifact.archive.to-html)
|
|
"The blog reference refers to the same blog object."
|
|
(let* ((archive (make-instance 'hssg.blog.artifacts:archive-page-artifact
|
|
:blog blog :periods (list)))
|
|
(html (hssg.blog.artifact.archive::archive->html archive)))
|
|
(with-slots ((data hssg.artifact::data))
|
|
html
|
|
(assert-eq blog (cdr (assoc :blog data))))))
|
|
(clunit:run-test 'references-blog)
|
|
|
|
(deftest empty-archive (hssg-blog.artifact.archive.to-html)
|
|
"The list of periods is empty"
|
|
(let* ((archive (make-instance 'hssg.blog.artifacts:archive-page-artifact
|
|
:blog blog :periods (list)))
|
|
(html (hssg.blog.artifact.archive::archive->html archive)))
|
|
(with-slots ((data hssg.artifact::data))
|
|
html
|
|
(assert-false (cdr (assoc :periods data))))))
|
|
|
|
(deftest nonempty-archive (hssg-blog.artifact.archive.to-html)
|
|
"The periods are transferred to the data."
|
|
(let* ((periods '(a b c))
|
|
(archive (make-instance 'hssg.blog.artifacts:archive-page-artifact
|
|
:blog blog :periods periods))
|
|
(html (hssg.blog.artifact.archive::archive->html archive)))
|
|
(with-slots ((data hssg.artifact::data))
|
|
html
|
|
(assert-equal periods (cdr (assoc :periods data))))))
|
|
|
|
(deftest initial-data (hssg-blog.artifact.archive.to-html)
|
|
"The initial data from the blog is included."
|
|
(let* ((archive (make-instance 'hssg.blog.artifacts:archive-page-artifact
|
|
:blog blog :periods (list)))
|
|
(html (hssg.blog.artifact.archive::archive->html archive)))
|
|
(with-slots ((data hssg.artifact::data))
|
|
html
|
|
(assert-equal (slot-value blog 'hssg.blog.artifacts:initial) (cddr data))
|
|
(assert-true t))))
|