Literate Org Haskell

meow.el

(defconst fn/haskell-file-extension ".hs"
  "The de facto haskell file extension.")

(defun fn/add-haskell-file-extension (name)
  "Add the extension of .hs to a file or buffer NAME."
  (if (string/ends-with name fn/haskell-file-extension)
      name (concat name fn/haskell-file-extension)))

(defvar fn/org-haskell-mode-hook nil
  "Hook when buffer is haskellized.")

(defun fn/haskellize-buffer-file (&optional buffer)
  "Renames an BUFFER with a .hs extension if it doesn't have one."
  (interactive)
  (with-current-buffer (or buffer (current-buffer))
    (save-buffer)
    (lexical-let ((name (buffer-name))
        (file-name (buffer-file-name)))
      (if (not (and file-name (file-exists-p file-name)))
          (error "Buffer '%s' has no backing file" name)
        (lexical-let ((haskellized-name (fn/add-haskell-file-extension name))
            (haskellized-file-name (fn/add-haskell-file-extension file-name)))
          (cond
           ((get-buffer haskellized-name)
            (error "A buffer named '%s' already exists" haskellized-name))
           ((string-equal name haskellized-name)
            (message "Buffer %s is already haskellized" haskellized-name))
           (t
            (rename-file file-name haskellized-file-name t)
            (rename-buffer haskellized-name)
            (set-visited-file-name haskellized-file-name)
            (set-buffer-modified-p nil)
            (message "Buffer %s is now haskellized" haskellized-name))))))))

(defun fn/org-haskell-buffer-p (&optional buffer)
  "Check if BUFFER is an org-haskell buffer."
  (with-current-buffer (or buffer (current-buffer))
    (and (eq major-mode 'haskell-mode)
       (fboundp 'org-src-edit-buffer-p)
       (org-src-edit-buffer-p))))

(defun fn/haskellize-org-haskell-buffer (&rest _)
  "Haskellize org haskell buffer."
  (when (fn/org-haskell-buffer-p)
    (fn/haskellize-buffer-file (current-buffer))
    (run-hooks 'fn/org-haskell-mode-hook)))

(defun fn/save-org-haskell-buffer (&rest _)
  "Save haskell buffer along with the edit buffer."
  (when (fn/org-haskell-buffer-p)
    (save-buffer)))

(defun fn/cleanup-org-haskell-buffer (orig-fun &rest args)
  "Cleanup the org-haskell buffer when exiting the edit buffer."
  (lexical-let ((org-haskell-file-name (buffer-file-name))
      (org-haskell-buffer-p (fn/org-haskell-buffer-p)))
    (prog1
        (apply orig-fun args)
      (when (and (file-exists-p org-haskell-file-name) org-haskell-buffer-p)
        (delete-file org-haskell-file-name))))))

(add-hook 'org-src-mode-hook #'fn/haskellize-org-haskell-buffer t)

(advice-add 'org-edit-src-save :before #'fn/save-org-haskell-buffer)
(advice-add 'org-edit-src-exit :around #'fn/cleanup-org-haskell-buffer)