;;; -*- Lisp -*-

(in-package :asdf)
(use-package :asdf-test)
(import '(asdf-test::DBG))

(defparameter *tmp-directory* (subpathname *asdf-directory* "build/"))
(setf *central-registry* nil)

(defun under-tmp-directory (designator &optional (defaults *tmp-directory*))
  (namestring (subpathname defaults designator)))

(defun create-conf-files (&optional (path *tmp-directory*))
  (let ((v `(("conf.d/conf1.conf"
              ((:directory ,(under-tmp-directory "dir1/"))))
             ("conf.d/conf2.conf"
              ((:tree ,(under-tmp-directory "dir2/"))))
             ;; this is for testing the :here directive
             ("dir5/conf.conf"
              ((:directory (:here "dir6"))))
             ("dir8/conf.conf"
              ((:directory (:here))))
             ("dir9/dira/conf.conf"
              ((:tree (:here)))))))
    (loop
      :for (file contents) :in v
      :for name = (under-tmp-directory file path)
      :do
      (ensure-directories-exist name)
      (with-open-file (out name
                           :direction :output
                           :if-exists :supersede)
        (with-standard-io-syntax
          (format out "~{~S~%~}" contents))))))

(defparameter *tmp-asd-directories*
  (loop
    :for dir
    :in '("dir1/"                       ; foo0
          "dir2/dir3/"                  ; foo1
          "dir2/dir4/"                  ; foo2
          "dir2/"                       ; foo3
          ;; system here should be found because of :here directive
          "dir5/dir6/"                  ; foo4
          ;; system here should /not/ be found because of :here directive
          "dir5/dir7/"                  ; foo5
          "dir8/"                       ; foo6
          "dir9/dira/"                  ; foo7 should be found because of :here :tree
          "dir9/dira/dirc/"              ; foo8 ditto
          "dir9/dirb/")                 ; foo9 should /not/ be found -- not under :here :tree
    :collect (under-tmp-directory dir)))

(defun create-asd-files ()
  (loop
    :for d :in *tmp-asd-directories*
    :for i :from 0 :do
    (ensure-directories-exist d)
    (with-open-file (s (merge-pathnames* (format nil "foo~D.asd" i) d)
                       :direction :output
                       :if-exists :supersede
                       :if-does-not-exist :create)
      (format s "(defsystem :foo~D)~%" i))))

(assert-equal (asdf::parse-output-translations-string
               (join-namestrings '("/foo" "/bar" "" "/baz" "/quux")))
              '(:output-translations ("/foo" "/bar") :inherit-configuration
                ("/baz" "/quux")))
(assert-equal (asdf::parse-output-translations-string
               (join-namestrings '("/" "")))
              '(:output-translations ("/" nil) :ignore-inherited-configuration))
(assert-equal (asdf::parse-output-translations-string
               (join-namestrings '("/" "" "")))
              '(:output-translations ("/" nil) :inherit-configuration))
(assert-equal (asdf::parse-output-translations-string
               (join-namestrings '("/" "/")))
              '(:output-translations ("/" "/") :ignore-inherited-configuration))
(assert-equal (asdf::parse-output-translations-string
               "(:output-translations (\"/\" \"/\") :ignore-inherited-configuration)")
              '(:output-translations ("/" "/") :ignore-inherited-configuration))

(create-asd-files)
(create-conf-files)

(format t "~&subdirectories of dir2/: ~S~%" (subdirectories (under-tmp-directory "dir2/")))
(assert-equal 2 (length (subdirectories (under-tmp-directory "dir2/"))))

(format t "~&subdirectories of dir5/: ~S~%" (subdirectories (under-tmp-directory "dir5/")))
(assert-equal 2 (length (subdirectories (under-tmp-directory "dir5/"))))

(initialize-source-registry
 `(:source-registry (:include ,(under-tmp-directory "conf.d/"))
                    (:include ,(under-tmp-directory "dir5/"))
                    (:include ,(under-tmp-directory "dir8/"))
                    (:include ,(under-tmp-directory "dir9/dira/"))
                    :ignore-inherited-configuration))

(defun dump-source-registry ()
  (format t "~&Source Registry:~%")
  (loop :for k :being :each hash-key :of *source-registry*
     :using (hash-value v)
        :do (format t "~a --> ~a~%" k v)))

(dump-source-registry)


(assert (find-system :foo0 nil))
(assert (find-system :foo1 nil))
(assert (find-system :foo2 nil))
(assert (find-system :foo3 nil))
(assert (find-system :foo4 nil))
(assert (not (find-system :foo5 nil)))
(assert (find-system :foo6 nil))
(assert (find-system :foo7 nil))
(assert (find-system :foo8 nil))
(assert (not (find-system :foo9 nil)))

(format t "~&A: ~S~%B: ~S~%"
        (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
        (under-tmp-directory "dir2/bar/baz.lisp"))
(assert-equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
              (under-tmp-directory "dir2/bar/baz.lisp"))


(DBG "Testing link farm found through source registry.")
(defparameter *link-farm-directory* (under-tmp-directory "link-farm/"))



(defun link-asd-files ()
  (loop
    :for d :in *tmp-asd-directories*
    :for i :from 0
    :as asd-file = (merge-pathnames* (format nil "foo~D.asd" i) d)
    :do (assert (probe-file asd-file))
        (run-program (format nil "ln -s ~a ~a" (namestring asd-file) (namestring *link-farm-directory*)))))

;;; prepare for link farm test
;; clean up first
(describe *link-farm-directory*)
(when (uiop:directory-exists-p *link-farm-directory*)
  (uiop:delete-directory-tree *link-farm-directory*
                              :validate (lambda (x) (subpathp x *tmp-directory*))))
;; create the link farm
(ensure-directories-exist *link-farm-directory*)
(link-asd-files)
;;; test following symlinks
(initialize-source-registry
 `(:source-registry (:include ,(namestring *link-farm-directory*))
   :ignore-inherited-configuration))
(dump-source-registry)

(assert (find-system :foo0 nil))
(assert (find-system :foo1 nil))
(assert (find-system :foo2 nil))
(assert (find-system :foo3 nil))
(assert (find-system :foo4 nil))
(assert (not (find-system :foo5 nil)))
(assert (find-system :foo6 nil))
(assert (find-system :foo7 nil))
(assert (find-system :foo8 nil))
(assert (not (find-system :foo9 nil)))
