hy-website/editor.hy

"""
HTML writer for trees.st

This application will serve as a platform to edit and deploy posts.
"""

;; TODO:
;; * purification and refinement

(import [datetime [date]])
(import [string [Template]])
(import [subprocess [run]])
(import [tkinter [*]])
(import [tkinter [filedialog]])
(import [tkinter [ttk]])

;; Globals
;; This is, essentially, a direct copy of the de facto standard layout
;; used for hand-written posts. This should only be changed after by-hand
;; experimentation in hand-written test posts, and it should be applied to
;; all existing posts before being changed here.
(setv template {"prefix" "{% if type == \"rss\" %}\n\t{% extends \"rss-item.xml\" %}\n{% else %}\n\t{% extends \"blog-post.html\" %}\n{% endif %}\n\n{% block title %}"
               "infix1" "{% endblock title %}\n{% block date %}"
               "infix2" "{% endblock date %}\n{% block summary %}\n\t"
               "infix3" "{% endblock summary %}\n{% block content %}\n\t<p>\n\t\t"
               "suffix" "\t</p>\n{% endblock content %}"})
(setv post-dir "templates/posts/")
(setv replace-text "<REPLACE-ME-PLEASE>")

;; Setup top-level and main Frame

(setv root (Tk))
(.title root "Post Editor")

(setv mainframe (.Frame ttk root :padding "3 3 12 12"))
(.grid mainframe :column 0 :row 0 :sticky '(N W E S))
(.columnconfigure root 0 :weight 1)
(.rowconfigure root 0 :weight 1)

;; Setup widgets for writing posts

(setv post-title (StringVar))
(setv title-entry (.Entry ttk mainframe :width 70 :textvariable post-title))
(.grid title-entry :column 1 :row 0 :sticky '(N W))
(.grid (.Label ttk mainframe :text "Title") :column 0 :row 0 :sticky '(W))

(setv post-summary (Text mainframe :width 80 :height 5 :wrap "word"))
(.grid post-summary :column 1 :row 1 :sticky '(N W))
(.grid (.Label ttk mainframe :text "Summary") :column 0 :row 1 :sticky '(W))

(setv post-content (Text mainframe :width 80 :height 25 :wrap "word"))
(.grid post-content :column 1 :row 2 :sticky '(N W))
(.grid (.Label ttk mainframe :text "Content") :column 0 :row 2 :sticky '(W))

;; Define functionality

;; thunk
;; load a file into the content boxes
(defn load [#* args]
  (with [fd (open (.askopenfilename filedialog) "r")]
    (set-variables (parse-file (.read fd)))))

;; thunk
;; place post-dict into the appropriate variables
(defn set-variables [post-dict]
  (.set post-title (get post-dict "title"))
  (.delete post-summary "1.0" "end")
  (.insert post-summary "1.0" (get post-dict "summary"))
  (.delete post-content "1.0" "end")
  (.insert post-content "1.0" (process-content-read (get post-dict "content"))))

;; string -> dict
;; parse raw-post into a dict of the appropriate parts
;; for insertion into the editor
;; TODO make this... not bad?
(defn parse-file [raw-file]
  (setv new-file (.lstrip raw-file (get template "prefix")))
  (setv new-file (.rstrip new-file (get template "suffix")))
  (setv new-file (.replace new-file (get template "infix1") replace-text))
  (setv new-file (.replace new-file (get template "infix2") replace-text))
  (setv new-file (.replace new-file (get template "infix3") replace-text))
  (setv file-arr (.split new-file replace-text))
  (return {"title" (get file-arr 0)
           "summary" (get file-arr 2)
           "content" (get file-arr 3)}))

;; thunk
;; save current contents of editor to disk
(defn save [#* args]
  (setv post-date (.isoformat (.today date)))
  (with [fd (open (+ post-dir post-date ".html") "w")]
    (.write fd (+ (get template "prefix")
                  (.get post-title)
                  (get template "infix1")
                  post-date
                  (get template "infix2")
                  (.get post-summary "1.0" "end")
                  (get template "infix3")
                  (process-content-write (.get post-content "1.0" "end"))
                  (get template "suffix")))))

;; string string -> string
;; process raw-input according to mode
;; if mode is "w", wrap paragraphs in HTML "<p>" tags
;; if mode is "r", replace HTML "<p>" tags with "\n\n"
(defn _process-content [raw-input mode]
  (setv read-chars "\n\n")
  (setv write-chars "\n\t</p>\n\t<p>\n\t\t")
  (return (if (= mode "r")
              (.replace raw-input write-chars read-chars)
              (.replace raw-input read-chars write-chars))))

;; string -> string
;; call `_process-content` with a mode of "w"
(defn process-content-write [raw-input]
  (return (_process-content raw-input "w")))

;; string -> string
;; call `_process-content` with a mode of "r"
(defn process-content-read [raw-input]
  (return (_process-content raw-input "r")))

;; thunk
;; save the current contents of the editor then
;; execute a shell script to deploy the website
(defn deploy [#* args]
  (try
    (save)
    (run '("sh" "deploy.sh") :check True)
    (except [e BaseException]
      (return))))

;; Setup functionality buttons

(.grid (.Button ttk mainframe :text "Load" :command load) :column 0 :row 3 :sticky '(N S))
(.grid (.Button ttk mainframe :text "Save" :command save) :column 1 :row 3 :sticky '(N S))
(.grid (.Button ttk mainframe :text "Deploy" :command deploy) :column 2 :row 3 :sticky '(N S))

;; Final adjustments and run

(for [child (.winfo-children mainframe)]
  (.grid-configure child :padx 5 :pady 5))

(.focus title-entry)

(.mainloop root)