(in-package :quickref)

(defparameter *quickref-basedir* (user-homedir-pathname))

(defun from-quickref-dir (relative-path)
  (merge-pathnames relative-path (quickref-dir)))

(defun quickref-dir ()
  (merge-pathnames "quickref/" *quickref-basedir*))

(defun clean-directory (path)
  (dolist (dir (directory (merge-pathnames "*/" (truename path))))
    (sb-ext:delete-directory dir :recursive t))
  (dolist (file (directory (merge-pathnames "*.*" (truename path))))
    (delete-file file)))

(defun all-directories (path)
  (merge-pathnames "*/" (truename path)))

(defun all-files (path)
  (merge-pathnames "*.*" (truename path)))

(defun get-directory-list (path)
  (loop for dir in (directory (all-directories path))
     collect (car (last (pathname-directory dir)))))

(defun get-file-list (path)
  (loop for file in (directory (all-files path))
     nconc (if (string= (pathname-name file) "index")
	       nil
	       (list (pathname-name file)))))

(defun get-texi-pathnames ()
  (loop for pathname in (directory
			 (all-files (from-quickref-dir "texis/")))
     collect pathname))

(defun clean-or-create (directory)
  (if (probe-file directory)
      (clean-directory directory)
      (ensure-directories-exist directory)))

(defun log-texi-error (err texi)
  (let ((filepathname (from-quickref-dir
		       (format nil "logs/makeinfo/~A.log"
			       (pathname-name texi)))))
    (with-open-file (file filepathname
			  :direction :output
			  :if-exists :supersede
			  :if-does-not-exist :create)
      (format file err))))

(defun setup-quickref-dir (&key declt makeinfo)
  (when declt
    (clean-or-create (from-quickref-dir "logs/declt-map/"))
    (clean-or-create (from-quickref-dir "texis/")))
  (when makeinfo
    (clean-or-create (from-quickref-dir "logs/makeinfo/"))
    (clean-or-create (from-quickref-dir "website/"))))

(defun find-readme (release-name)
  (let* ((release (ql-dist:find-release release-name))
	 (asd-file (if release
		       (ql-dist:base-directory release)
		       (asdf:system-source-directory release-name))))
    (car (directory (merge-pathnames "README.*"
				     asd-file)))))
(defun file-to-string (pathname)
  (with-open-file (file pathname)
    (handler-case
	(alexandria:read-file-into-string
	 file
	 :external-format :utf-8)
      (error ()
	(handler-case
	    (alexandria:read-file-into-string
	     file
	     :external-format :latin-1)
	  (error ()
	    (alexandria:read-file-into-string
	     file
	     :external-format '(:utf-8 :replacement #\?))))))))

(defmacro read-write-file ((pathname content stream) &body body)
  `(let ((,content (file-to-string ,pathname)))
     (with-open-file (,stream
		      ,pathname
		      :direction :output
		      :if-exists :supersede)
       ,@body)))

(defun format-readme (readme)
  (let ((readme-txt (file-to-string readme)))
    (if (find (string-downcase (pathname-type readme))
	      '("md" "markdown" "mdown" "mkdn" "mdwn" "mkd")
	      :test #'string=)
	(handler-case
	    (cmark-markdown-to-html readme-txt (length readme-txt) 0)
	  (error ()
	    (with-output-to-string (out)
	      (parse-string-and-print-to-stream readme-txt out))))
	(format nil "<pre style=\"white-space: pre-wrap;\">~%~A~%</pre>"
		readme-txt))))

(defun use-readme-intro (html-pathname readme-pathname)
  (read-write-file (html-pathname html-text stream)
    (write-sequence
     (regex-replace
      "\\<h2 class=\\\"chapter\\\"\\>1 Introduction\\<\\/h2\\>\\n"
      html-text
      (list :match
	    (format-readme readme-pathname)))
     stream)))

(defun file-copy (source destination)
  (with-open-file (in source :direction :input)
    (with-open-file (out destination :direction :output)
      (uiop:copy-stream-to-stream in out))))

(defun copy-stylesheets ()
  (let ((styles '("main.css" "document.css"))
	(css-dir (merge-pathnames "css/"
				  (asdf:system-source-directory "quickref")))
	(website-dir (from-quickref-dir "website/")))
    (dolist (file styles)
      (file-copy (merge-pathnames file css-dir)
		 (merge-pathnames file website-dir)))))