Common lisp code to extract keep notes from google takeout into org-mode files

google-keep-to-org-file.lisp

;;;; code to extract keep notes from google takeout into org-mode files
;; It's messy code it the result of an interactive coding session.

(in-package #:common-lisp-user)

(ql:quickload '(alexandria zip cl-ppcre cl-json flexi-streams))



(defpackage #:scratch-keep
  (:nicknames #:k)
  (:use :cl #:alexandria))

(in-package #:scratch-keep)


;;; Trying to read takeout from keep

(defparameter *takeout* "~/Downloads/takeout-20200507T000231Z-001.zip")

(progn
  (defparameter *root* (merge-pathnames "keep/"
					(user-homedir-pathname)))
  (ensure-directories-exist *root*))


(defun extract-name-from-entry (entry-name &optional (suffix "json"))
  (multiple-value-bind (_ groups)
      (ppcre:scan-to-strings (format nil "Takeout/Keep/(.+)\\.~a$" suffix) entry-name)
    (declare (ignore _))
    (when groups
      (let ((name (aref groups 0)))
	name))))

;; to test:
(extract-name-from-entry "Takeout/Keep/Asdf.html") 
(extract-name-from-entry "Takeout/Keep/Asdf.json") 

(extract-name-from-entry "Takeout/Keep/2019-10-01T21_37_37.352-04_00.json") 

(defun normalize (string)
  (when string
    (string-downcase (substitute #\- #\Space string))))

;; Extract each json notes
(progn
  (defparameter *notes* (make-hash-table :test 'equalp))
  (zip:with-zipfile (zip *takeout*)
    (zip:do-zipfile-entries (entry-name entry zip)
      (let ((name (extract-name-from-entry entry-name)))
	(when name
	  (when (gethash (normalize name) *notes*)
	    (warn "Note with name \"~a\" already exists." (normalize name)))
	  (setf (gethash (normalize name) *notes*)
		(cl-json:decode-json-from-string
		 (flexi-streams:octets-to-string (zip:zipfile-entry-contents entry)
						 :external-format :utf8)))
	  #+nil
	  (format t "~&~a" name))))))

(zip:with-zipfile (zip *takeout*)
  (zip:do-zipfile-entries (entry-name entry zip)
    (unless (or (extract-name-from-entry entry-name)
		(gethash (normalize (extract-name-from-entry entry-name "html")) *notes*))
      (print entry-name))
    #+nil 
    (let ((name (extract-name-from-entry entry-name)))
      (when name
	  (setf (gethash (normalize name) *notes*)
		(cl-json:decode-json-from-string
		 (flexi-streams:octets-to-string (zip:zipfile-entry-contents entry)
						 :external-format :utf8)))
	(format t "~&~a" name)))))

;; How many notes do I have?
(hash-table-count *notes*)
;; => 79

;; Taking a look at the structure of a note
;; (also used slime-inspect on *notes*)
(first
 (hash-table-alist *notes*))

(defun note-title (note)
  "Extract a note's title."
  (cdr (assoc :title note)))

(defun note-type-of (note)
  "Determine the type of a note."
  (cond
    ((assoc :list-content note) :list)
    ((assoc :text-content note) :text)))

(defun note-content (note)
  (cdr (or (assoc :list-content note) (assoc :text-content note))))

;; Making sure I don't have notes of other types.
(print (mapcar (lambda (note) (note-type-of (cdr note)))
	       (hash-table-alist *notes*)))


;;; Serializing notes

(defun note-tags (note)
  (let ((labels (assoc :labels note)))
    labels
    (when labels
      (loop for label in (cdr labels)
	 collect
	   (normalize (cdar label))))))

(defun pretty-print-text-note (note-json)
    (format t "#+TITLE ~A~%"
	    (note-title note-json))
    (format t "# Tags ~{#~A~^ ~}~%~%~A"
	    (note-tags note-json)
	    (note-content note-json)))

(let ((note (first
	     (hash-table-alist *notes*))))
  (destructuring-bind (name &rest note-json) note
    (pretty-print-text-note note-json)))

(defun pretty-print-list-note (note-json)
    (format t "#+TITLE ~A~%"
	    (note-title note-json))
    (format t "# Tags ~{#~A~^ ~}~%~%"
	    (note-tags note-json))
    (loop
       for entry in (note-content note-json)
       for text = (cdr (assoc :text entry))
       for is-checked = (cdr (assoc :is-checked entry))
       do
	 (if is-checked
	     (format t "-[x] ~a~%" text)
	     (format t "-[ ] ~a~%" text))))

;; Trying to find a note of type list to see it's structure
(pretty-print-list-note
 (cdr
  (find-if (lambda (note)
	     (destructuring-bind (name &rest note-json) note
	       (eq :list
		   (note-type-of note-json))))
	   (hash-table-alist *notes*))))

;; Actually create all the notes
(loop
   :for name :being :the :hash-key :of *notes* :using (hash-value note-json)
   :do
     (with-output-to-file (*standard-output* (merge-pathnames (format nil "~a.org" name) *root*))
       (case (note-type-of note-json)
	 (:text (pretty-print-text-note note-json))
	 (:list (pretty-print-list-note note-json))
	 (t (format *error-output* "Note \"~a\" is of unknown type." name)))))