cl-hssg/test/hssg/file-system.lisp

;;;; SPDX-License-Identifier AGPL-3.0-or-later

;;;; file-system.lisp  File system implementation tests
;;;; 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/test/filesystem
  (:documentation "File system implementation tests")
  (:use #:cl)
  (:import-from #:clunit
     #:defsuite #:deffixture #:deftest #:assert-true #:assert-eql #:assert-equal)
  (:import-from #:hssg/test-mocking #:with-mock)
  (:export test-all all-tests hssg))
(in-package #:hssg/test/filesystem)

(defsuite hssg.filesystem (hssg/test:hssg))
(defsuite hssg.filesystem.get-path (hssg.filesystem))
(defsuite hssg.filesystem.write (hssg.filesystem))


;;; --- FAKES -----------------------------------------------------------------
(defclass dummy-instruction (hssg:file-system-instruction)
  ((on-write :initarg :on-write :initform (lambda (self) self)
     :documentation "Callback to execute when the instruction is written."))
  (:documentation "A fake file system instruction"))

(defclass dummy-filesystem (hssg:file-system)
  ()
  (:documentation "A fake file system"))

(defmethod hssg:write-to-filesystem ((instruction dummy-instruction)
                                                file-system)
  (funcall (slot-value instruction 'on-write) instruction))

(defmethod hssg:write-to-filesystem (instruction 
                                                (file-system dummy-filesystem))
  nil)


;;; --- FILE SYSTEM TESTS -----------------------------------------------------
(deffixture hssg.filesystem.get-path (@body)
  "Creates a dummy base file system"
  (let* ((base
           (make-instance 'hssg:base-file-system :directory #p"base"))
         (overlay1
           (make-instance
             'hssg:overlay-file-system :directory #p"overlay-1" :parent base))
         (overlay2
           (make-instance
             'hssg:overlay-file-system :directory #p"overlay-2" :parent overlay1)))
    (declare (ignorable base overlay1 overlay2))
    @body))

(deftest base-file-system-path (hssg.filesystem.get-path)
  "The path of a base file system is its slot value."
  (let ((path (hssg.filesystem::file-system-path base)))
    (assert-equal #p"base/" path)))

(deftest single-overlay-file-system-path (hssg.filesystem.get-path)
  "The path of an overlay file system is the merge of its own and the parent's path."
  (let ((path (hssg.filesystem::file-system-path overlay1)))
    (assert-equal #p"base/overlay-1/" path)))

(deftest multi-overlay-file-system-path (hssg.filesystem.get-path)
  "An overlay on top of an overlay merges all its parent file systems"
  (let ((path (hssg.filesystem::file-system-path overlay2)))
    (assert-equal #p"base/overlay-1/overlay-2/" path)))


;;; ---------------------------------------------------------------------------
(deffixture hssg.filesystem.write (@body)
  "Creates a counter variable to keep track of mock calls."
  (let ((counter 0))
    (declare (ignorable counter))
    @body))

(deftest write/copy-file/base-filesystem (hssg.filesystem.write)
  "Copying a file verbatim to a base file system"
  (let ((file-system (make-instance 'hssg:base-file-system :directory #p"output"))
        (instruction (make-instance 'hssg:copy-file :path #p"css/main.css" :base-path #p"content")))
    (with-mock ((hssg.filesystem::copy-file
                  (lambda (original copy)
                    (incf counter)
                    (assert-equal #p"content/css/main.css" original)
                    (assert-equal #p"output/css/main.css" copy))))
      (hssg:write-to-filesystem instruction file-system)
      (assert-eql 1 counter))))

(deftest write/write-string/base-filesystem (hssg.filesystem.write)
  "Writing a string to a file in a base file system"
  (let ((file-system (make-instance 'hssg:base-file-system
                       :directory #p"output"))
        (instruction (make-instance 'hssg:write-string-contents
                       :path #p"css/main.css"
                       :contents "Hello world")))
    (with-mock ((hssg.filesystem::write-string-to-file
                  (lambda (contents path)
                    (incf counter)
                    (assert-equal "Hello world" contents)
                    (assert-equal #p"output/css/main.css" path))))
      (hssg:write-to-filesystem instruction file-system)
      (assert-eql 1 counter))))

(deftest write/write-string/overlay-filesystem (hssg.filesystem.write)
  "Writing a string to an overlay file system resolved the path correctly."
  (let ((file-system (make-instance 'hssg:overlay-file-system
                      :directory #p"blog"
                      :parent (make-instance 'hssg:base-file-system
                                             :directory #p"output")))
        (instruction (make-instance 'hssg:write-string-contents
                       :path #p"css/main.css"
                       :contents "Hello world")))
    (with-mock ((hssg.filesystem::write-string-to-file
                  (lambda (contents path)
                    (incf counter)
                    (assert-equal "Hello world" contents)
                    (assert-equal #p"output/blog/css/main.css" path))))
      (hssg:write-to-filesystem instruction file-system)
      (assert-eql 1 counter))))

(deftest write/copy-directory/base-filesystem (hssg.filesystem.write)
  "Copying a directory recursively to a base file system copies the entire directory"
  (let ((file-system (make-instance 'hssg:base-file-system :directory #p"output"))
        (instruction (make-instance 'hssg:copy-directory :path #p"assets/images" :base-path #p"content"))
        (counter 0))
    (with-mock ((hssg.filesystem::copy-directory
                  (lambda (original copy)
                    (incf counter)
                    (assert-equal #p"content/assets/images/" original)
                    (assert-equal #p"output/assets/images/"  copy)
                    nil)))
      (hssg:write-to-filesystem instruction file-system)
      (assert-eql 1 counter))))

(deftest write/compound-instruction/base-filesystem (hssg.filesystem.write)
  "Writing a compound instruction writes all its children in order."
  (let* ((file-system (make-instance 'dummy-filesystem))
         (written (list))
         (dummy1 (make-instance 'dummy-instruction
                   :on-write (lambda (self) (push self written))))
         (dummy2 (make-instance 'dummy-instruction
                   :on-write (lambda (self) (push self written))))
         (instruction (make-instance 'hssg:compound-instruction
                        :instructions (list dummy1 dummy2))))
    (hssg:write-to-filesystem instruction file-system)
    (assert-eql 2 (length written))
    (loop for instruction in written
          for dummy       in (list dummy2 dummy1)  ; Reverse order because of push!
          do (assert-true (eq dummy instruction)))))


;;; --- HELPER FUNCTIONS ------------------------------------------------------
;;; Here we have to actually access the file system, so we will be working with
;;; temporary files

(defsuite hssg.filesystem.helper (hssg.filesystem))
(defsuite hssg.filesystem.helper.copy-directory (hssg.filesystem.helper))


(defun file-equal-p (p1 p2)
  "Whether the contents of two files are the same."
  (declare (type pathname p1 p2))
  (let ((s1 (uiop/stream:read-file-string p1))
        (s2 (uiop/stream:read-file-string p2)))
    (string= s1 s2)))

(deffixture hssg.filesystem.helper.copy-directory (@body)
  (let ((original (uiop/pathname:ensure-directory-pathname
                    #p"test/hssg/sample-files/directory-tree/"))
        (copy     (uiop/pathname:ensure-directory-pathname
                    #p"test/hssg/sample-files/copy-tree/")))
    (declare (ignorable original copy))
    (unwind-protect
        (progn
          @body)
      (uiop/filesystem:delete-directory-tree
        copy :if-does-not-exist :ignore :validate t))))

(deftest copy-directory (hssg.filesystem.helper.copy-directory)
  (hssg.filesystem::copy-directory original copy)
  (dolist (p '(#p"a.txt" #p"b.txt" #p"x/c.txt" #p"x/y/d.txt" #p"x/y/e.txt"))
    (assert-true (file-equal-p
                   (fad:merge-pathnames-as-file original p)
                   (fad:merge-pathnames-as-file copy     p)))))