timecalc/web.lisp

(defpackage :timecalc-web
  (:use :cl :with-user-abort :cl-markup)
  (:import-from :timecalc-logic
                :convert :save-model
                :agetf)
  (:import-from :str
                :blankp)
  (:import-from :clack
                :clackup)
  (:import-from :ningle
                :<app>
                :route)
  (:export :start-server))

(in-package :timecalc-web)

(defvar *app* (make-instance '<app>))
(defvar *handler* nil
  "webapp handler reference")
(defvar *calculation-result* nil)

(defun start-server (port)
  "starts the web interface"
  
  (setf (route *app* "/" :method :get) #'index
        (route *app* "/result" :method :get) #'result
        (route *app* "/calculate" :method :post) #'calculate
        (route *app* "/loadModels" :method :post) #'load-or-reset-systems ;; old - DELETE
        (route *app* "/create" :method :get) #'create-system-page
        (route *app* "/create" :method :post) #'create-system
        (route *app* "/add" :method :post) #'load-new-system)
  
  (setf *handler* (clackup *app* :port port :debug nil))

  (handler-case
      (with-user-abort
        (bt:join-thread (find-if (lambda (th)
                                   (search "hunchentoot" (bt:thread-name th)))
                                 (bt:all-threads))))
    (user-abort ()
      (clack:stop *handler*))))

(defun index (&optional args)
  (declare (ignorable args))
  (setf *calculation-result* nil)
  (html5
   (:head
    ;; need to put CSS in here for flexbox
    (:script :type "text/javascript" (raw
"
function asyncConvert() {
  var from = document.getElementById('from').value;
  var to = document.getElementById('to').value;
  var time = document.getElementById('time').value;

  fetch('/calculate', {
    method: 'POST',
    body: JSON.stringify({
      'from': from,
      'time': time,
      'to': to
    }),
    headers: {
      'Content-type': 'application/json; charset=UTF-8'
    }
  });
}

function loadModels(reset = false) {
  var directory = document.getElementById('systemDirectory').files[0].webkitRelativePath;

  // CHANGE THIS TO READ SELECTED FILE
  fetch('/add', {
    method: 'POST',
    body: JSON.stringify({
      'directory': directory,
      'clear': reset
    }),
    headers: {
      'Content-type': 'application/json; charset=UTF-8'
    }
  });
}
"))
    (:style
"
body { font-size: 1.5rem; }
.container { display: grid; place-items: center; }
.form-container { display: flex; flex-direction: column; align-items: center; }
.convert-container { display: flex; flex-direction: row; align-items: center; }
input { height: 42px; font-size: 1rem;}
.needs-space { margin: 1rem; }
")
    (:link :rel "stylesheet" :href "custom.css"))
   (:body :class "container"
    (:p "Time Calculator")
    (:br)
    (:div :class "convert-container"
        ;; wrap this inside a disclosure group
        (:p "Select System Directory:")
        (:input :type "file" :id "systemDirectory" :name "systemDirectory" :class "needs-space" :webkitdirectory)
        (:button :type "button" :onclick "loadModels()"
                 "Load Models")
        (:button :type "button" :onclick "loadModels(true)"
                 "Reset Models"))
    (:br)
    (:div :class "form-container"
      (:div :class "convert-container"
        (:p "Time")
        (:input :type "text" :id "time" :name "time" :class "needs-space"))
      (:br)
      
      (:br)
      (:div :class "convert-container"
        (:select :name "from" :id "from"
                 (loop :for model :being :the :hash-value :of timecalc-logic::*models*
                       :collect
                       (markup (:option :value (gethash "key" model) (gethash "name" model)))))
        (:p :class "needs-space" "To")
        (:select :name "to" :id "to"
                 (loop :for model :being :the :hash-value :of timecalc-logic::*models*
                       :collect
                       (markup (:option :value (gethash "key" model) (gethash "name" model))))))
      (:br)
      (:button :type "button" :onclick "asyncConvert()"
               "Convert!"))
    (:br)
    (:iframe :src "/result" :frameBorder "0"))))

(defun result (&optional args)
  (html5
   (:head
    (:meta :http-equiv "refresh" :content (if *calculation-result* "-1" "1")))
   (:body
    (:p (or *calculation-result* "")))))

(defun calculate (&optional args)
  (setf *calculation-result* 
        (convert (agetf "time" args) (agetf "to" args) (agetf "to" args))))

(defun create-system-page (&optional args)
  (html5
   ;; define javascript to output
   (:head
    )
   (:body
    (:form :method "POST" :action "/create"
      (create-label-and-input "key" "text" "Key")
      (create-label-and-input "name" "text" "System Name")
      (create-label-and-input "secondsInMinute" "text" "Seconds in Minute (leave blank for default)")
      (create-label-and-input "minutesInHour" "text" "Minutes in Hour (leave blank for default)")
      (create-label-and-input "hoursInDay" "text" "Hours in Day (leave blank for default)")
      (create-label-and-input "daysInYear" "text" "Days in Year (leave blank for default)")
      (create-label-and-input "secondsInYear" "text" "Seconds in Year")
      (create-label-and-input "usesGalacticSecond" "checkbox" "Uses GTS seconds? (leave blank for default)")
      (create-label-and-input "yz-galactic" "text" "GTS Year 0 (in seconds)")
      (create-label-and-input "yz-local" "checkbox" "Local Year 0 (in seconds)")
      (:input :type "submit" :value "Submit")))))

(defun create-system (&optional args)
  ;; parse all fields and generate the hashtable for
  ;; jzon:stringify to flip into proper JSON to spit out
  ;; into a file. (using the key as the filename)
  (let ((hash (make-hash-table :test 'equal))
        (yz (make-hash-table :test 'equal :size 2)))
    ;; gets our keys for the yearZero part first
    (setf (gethash "galactic" yz) (agetf "yz-galatic" args)
          (gethash "local" yz) (agetf "yz-local" args)
          (gethash "yearZero" hash) yz)

    (loop :for (k . v) :in args
          :unless (or (string= k "yz-galactic")
                      (string= k "yz-local"))
            :do (setf (gethash k hash) v))
    (save-model hash)))

(defmacro create-label-and-input (name type label &key (value ""))
  `(markup (:label :for ,name ,label)
           (:input :type ,type :name ,name ,@(unless (blankp value)
                                               `(:value ,value)))))


;; TODO: change this to parse the POST'd JSON and add to the models hashtable
(defun load-or-reset-systems (&optional args)
  (let* ((file (agetf "directory" args))
         (dir (str:concat (namestring (uiop:getcwd)) (getf (pathname-directory file) :relative) "/")))
    (when (and dir (uiop:directory-exists-p dir))
      (format t "loading models from ~a~%" dir)
      (force-output)
      (timecalc-logic:load-models (uiop:directory-files dir "*.system")
                                  :clear-before-load (agetf "reset" args)))))