src/main.lisp

(in-package txt2web)

(defvar *app-name* "txt2web")

(defun entry-point-no-args ()
  (setf *delivered* t)
  (entry-point uiop:*command-line-arguments*))

(defun entry-point (args)
  (let ((*package* (find-package :txt2web)))
    (catch :terminate
      (let ((compiler (apply #'make-instance 'compiler (parse-opts args))))
        (if (parse-only compiler)
            (let ((*package* (find-package :txt2web.lib)))
              (format t "~{~S~^~%~%~}" (reverse (ast compiler))))
            (write-compiled-file compiler)))))
  (values))

(defun parse-opts (args)
  (let ((mode :sources)
        (data (list :sources nil :target nil :js nil :css nil :body nil :compile nil :parse nil :beautify nil)))
    (loop :for arg :in args
       :do (alexandria:switch (arg :test #'string=)
             ("-o" (setf mode :target))
             ("--js" (setf mode :js))
             ("--css" (setf mode :css))
             ("--body" (setf mode :body))
             ("-c" (setf (getf data :compile) t))
             ("-p" (setf (getf data :parse) t))
             ("--beautify" (setf (getf data :beautify) t))
             (t (push arg (getf data mode)))))
    (unless (< 0 (length (getf data :sources)))
      (report-error "There should be at least one source"))
    (when (> 1 (length (getf data :target)))
      (report-error "There should be no more than one target"))
    (unless (> 1 (length (getf data :body)))
      (report-error "There should be no more than one body"))
    (unless (getf data :target)
      (setf (getf data :target)
            (let* ((sources (first (getf data :sources)))
                   (tokens (uiop:split-string sources :separator "."))
                   (target (format nil "~{~A~^.~}.html"
                                   (butlast tokens))))
              (list target))))
    (list :sources (getf data :sources)
          :target (first (getf data :target))
          :js (getf data :js)
          :parse (getf data :parse)
          :css (getf data :css)
          :body (first (getf data :body))
          :compile (getf data :compile)
          :beautify (getf data :beautify))))

(defun print-usage ()
  (lformat t :usage *app-name*))

(defun parse-file (filename)
  (handler-case
      (p:parse 'txt2web-grammar
               (alexandria:read-file-into-string filename :external-format :utf-8))
    (p:esrap-parse-error (e)
      (format t "~A~%" e)
      (throw :terminate nil))))

(defun report-error (fmt &rest args)
  (format t "ERROR: ~A~%" (apply #'format nil fmt args))
  (print-usage)
  (throw :terminate nil))

;;; JS

(defun minify-package (package-designator minify prefix)
  (setf (ps:ps-package-prefix package-designator) prefix)
  (if minify
      (ps:obfuscate-package package-designator)
      (ps:unobfuscate-package package-designator)))

(defmethod js-sources ((compiler compiler))
  (let ((ps:*ps-print-pretty* (beautify compiler)))
    (cond ((beautify compiler)
           (minify-package "TXT2WEB.MAIN" nil "qsp_")
           (minify-package "TXT2WEB.API"  nil "qsp_api_")
           (minify-package "TXT2WEB.LIB"  nil "qsp_lib_"))
          (t
           (minify-package "TXT2WEB.MAIN" t   "_")
           (minify-package "TXT2WEB.API"  t   "a_")
           (minify-package "TXT2WEB.LIB"  t   "l_")))
    (format nil "~{~A~^~%~%~}" (mapcar #'ps:ps* (reverse (js compiler))))))

;;; CSS

(defmethod css-sources ((compiler compiler))
  (format nil "~{~A~^~%~%~}" (css compiler)))

;;; HTML

(defmethod html-sources ((compiler compiler))
  (let ((flute:*escape-html* nil)
        (body-template (body compiler))
        (js (js-sources compiler))
        (css (css-sources compiler)))
    (with-output-to-string (out)
      (write
       (flute:h
         (html
          (head
           (meta :charset "utf-8")
           (title "txt2web"))
          (body
           body-template
           (style css)
           (script js))))
       :stream out
       :pretty nil))))

(defun filename-game (filename)
  (let ((filename (alexandria:lastcar (uiop:split-string filename :separator "/"))))
    (format nil "~{~A~^.~}" (butlast (uiop:split-string filename :separator ".")))))

(defmethod initialize-instance ((compiler compiler) &key sources ((:js js-files)) ((:css css-files)) ((:body body-file)) compile parse &allow-other-keys)
  (call-next-method)
  (with-slots (ast body css js)
      compiler
    ;; Compile the game's JS
    (dolist (source sources)
      (let ((ps (parse-file source))
            (game-name (filename-game source)))
        (destructuring-bind (kw &rest locations)
            ps
          (unless (eq kw 'lib:game)
            (report-error "Internal error!"))
          (push 
           `(lib:game (,game-name) ,@locations)
           ast))))
    (setf js (append ast js))
    ;; Does the user need us to do anything else
    (unless (or parse compile)
      ;; Read in body
      (when body-file
        (setf body
              (alexandria:read-file-into-string body-file :external-format :utf-8)))
      ;; Include js files
      (dolist (js-file js-files)
        (push (format nil "////// Included file ~A~%~A" js-file
                      (alexandria:read-file-into-string js-file :external-format :utf-8))
              js))
      ;; Include css files
      (when css-files
        ;; User option overrides the default css
        (setf css nil)
        (dolist (css-file css-files)
          (push (format nil "////// Included file ~A~%~A" css-file
                        (alexandria:read-file-into-string css-file :external-format :utf-8))
                css))))))

(defmethod write-compiled-file ((compiler compiler))
  (alexandria:write-string-into-file
   (if (compile-only compiler)
       ;; Just the JS
       (js-sources compiler)
       ;; All of it
       (html-sources compiler))
   (target compiler) :if-exists :supersede))