;; Taken from https://github.com/novoid/dot-emacs/blob/master/config.org
(defun my-generate-sanitized-alnum-dash-string (str)
  "Returns a string which contains only a-zA-Z0-9 with single dashes
 replacing all other characters in-between them.

 Some parts were copied and adapted from org-hugo-slug
 from https://github.com/kaushalmodi/ox-hugo (GPLv3)."
  (let* (;; Remove "<FOO>..</FOO>" HTML tags if present.
         (str (replace-regexp-in-string "<\\(?1:[a-z]+\\)[^>]*>.*</\\1>" "" str))
         ;; Remove org-mode links
         (str (replace-regexp-in-string "\\[\\[.*\\]\\[" "" str))
         ;; Remove URLs if present in the string.  The ")" in the
         ;; below regexp is the closing parenthesis of a Markdown
         ;; link: [Desc](Link).
         (str (replace-regexp-in-string (concat "\\](" ffap-url-regexp "[^)]+)") "]" str))
         ;; Replace "&" with " and ", "." with " dot ", "+" with
         ;; " plus ".
         (str (replace-regexp-in-string
               "&" " and "
               (replace-regexp-in-string
                "\\." " dot "
                (replace-regexp-in-string
                 "\\+" " plus " str))))
         ;; Replace German Umlauts with 7-bit ASCII.
         (str (replace-regexp-in-string "[Ä]" "Ae" str t))
         (str (replace-regexp-in-string "[Ü]" "Ue" str t))
         (str (replace-regexp-in-string "[Ö]" "Oe" str t))
         (str (replace-regexp-in-string "[ä]" "ae" str t))
         (str (replace-regexp-in-string "[ü]" "ue" str t))
         (str (replace-regexp-in-string "[ö]" "oe" str t))
         (str (replace-regexp-in-string "[ß]" "ss" str t))
         ;; Replace all characters except alphabets, numbers and
         ;; parentheses with spaces.
         (str (replace-regexp-in-string "[^[:alnum:]()]" " " str))
         ;; On emacs 24.5, multibyte punctuation characters like "："
         ;; are considered as alphanumeric characters! Below evals to
         ;; non-nil on emacs 24.5:
         ;;   (string-match-p "[[:alnum:]]+" "：")
         ;; So replace them with space manually..
         (str (if (version< emacs-version "25.0")
                  (let ((multibyte-punctuations-str "：")) ;String of multibyte punctuation chars
                    (replace-regexp-in-string (format "[%s]" multibyte-punctuations-str) " " str))
                str))
         ;; Remove leading and trailing whitespace.
         (str (replace-regexp-in-string "\\(^[[:space:]]*\\|[[:space:]]*$\\)" "" str))
         ;; Replace 2 or more spaces with a single space.
         (str (replace-regexp-in-string "[[:space:]]\\{2,\\}" " " str))
         ;; Replace parentheses with double-hyphens.
         (str (replace-regexp-in-string "\\s-*([[:space:]]*\\([^)]+?\\)[[:space:]]*)\\s-*" " -\\1- " str))
         ;; Remove any remaining parentheses character.
         (str (replace-regexp-in-string "[()]" "" str))
         ;; Replace spaces with hyphens.
         (str (replace-regexp-in-string " " "-" str))
         ;; Remove leading and trailing hyphens.
         (str (replace-regexp-in-string "\\(^[-]*\\|[-]*$\\)" "" str)))
    str))

(defun org-id-new-as-outline (&optional prefix)
    "Returns the ID property if set or generates and returns a new one if not set.
 The generated ID is stripped off potential progress indicator cookies and
 sanitized to get a slug. Furthermore, it is prepended with an ISO date-stamp
 if none was found before."
    (interactive)
    (let* ((title (get-title (buffer-file-name (or (buffer-base-buffer (current-buffer))
                                                   (current-buffer)))))
           (title (my-generate-sanitized-alnum-dash-string title))
           (previous-headlines
            (let (acc)
              (dolist (h (org-get-outline-path nil nil))
                (setq acc (concat acc (let ((pos (or (string-match "[:alnum:а-яА-Я]" h)
                                                     0)))
                                        (substring h pos (1+ pos))))))
              acc))
           (headline (nth 4 (org-heading-components)))
           (headline (my-generate-sanitized-alnum-dash-string headline))
           (headline (substring headline 0 (min 60 (length headline))))
           (headline (replace-regexp-in-string "[-]+$" "" headline))
           (date (or (when-let ((date-prop
                                 (or (org-entry-get (point) "Created")
                                     (org-entry-get (point) "CLOSED")
                                     (org-entry-get (point) "SCHEDULED"))))
                       (ts-format "%Y.%m.%d" (ts-parse date-prop)))
                     (let* ((now (format-time-string "%Y.%m.%d"))
                            (created-prop (format-time-string "[%Y-%m-%d %a]")))
                       (org-set-property "Created" created-prop)
                       now)))
           (headline-date
            (mapconcat 'identity (list date
                                       headline
                                       previous-headlines) "--"))
           (my-generate-sanitized-alnum-dash-string headline-date))
      (mapconcat 'identity (list title headline-date) "/")))

(defvar org-id-outline-method t)
(defun org-id-new-advice (func &rest args)
  "???"
  (if org-id-outline-method
      (apply #'org-id-new-as-outline args)
    (apply func args)))

(after! org
  (advice-add #'org-id-new :around #'org-id-new-advice)
  (setq org-attach-id-to-path-function-list '(capitlise-and-add-spaces)))

(defun capitlise-and-add-spaces (id)
  (let* ((id (replace-regexp-in-string (regexp-quote "-") " " id nil 'literal))
         (id (capitalize id)))
    id))

(defun org-attach-id-my-id (id)
  "TBD"
  (let* ((id (replace-regexp-in-string (regexp-quote "--") "/" id nil 'literal))
         (id (replace-regexp-in-string (regexp-quote "-") " " id nil 'literal))
         (id (capitalize id)))
    id))

(defun update-ids-everywhere ()
  (interactive)
  (let ((headlines-with-ids (org-ql-select (org-agenda-files)
                              '(property "ID")
                              :action #'element-with-markers)))
    (dolist (entry headlines-with-ids)
      (org-with-point-at (plist-get (cadr entry) :org-marker)
        (condition-case nil
            (reattach-with-new-id-method)
          (message (format "Failed reattaching for '%s'" (org-get-heading))))))))

(defun reattach-with-new-id-method ()
  (interactive)
  (message (format ">> %s" (org-entry-get (point) "ID")))
  (let ((new-id (org-id-new))
        (current-path (let ((org-attach-id-to-path-function-list
                             '(capitlise-and-add-spaces)))
                        (org-attach-dir))))
    (org-delete-property "ID")
    (org-set-property "ID" new-id)
    (when current-path
      (let* ((new-path (org-attach-dir t t))
             (files (directory-files current-path t directory-files-no-dot-files-regexp))
             (args (list "mv" nil 0 nil))
             (args (append args files))
             (args (append args (list new-path))))
        (when (not (string= current-path
                            new-path))
          (apply #'call-process args))))))