;;;; 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)))))